16. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 4/17/2018 8:06:42 PM Central Daylight Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.

16.1 Files compared

# Location File Last Modified
1 MCCF EDI TAS ePharmacy 031218.zip\MCCF EDI TAS ePharmacy 031218 TAS+ePhm+SDD+US433+US434+v1.01.docx Wed Dec 13 12:43:40 2017 UTC
2 MCCF EDI TAS ePharmacy 031218.zip\MCCF EDI TAS ePharmacy 031218 TAS+ePhm+SDD+US433+US434+v1.01.docx Tue Apr 17 22:43:00 2018 UTC

16.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 1 1234
Changed 0 0
Inserted 0 0
Removed 0 0

16.3 Comparison options

Whitespace
Character case Differences in character case are significant
Line endings Differences in line endings (CR and LF characters) are ignored
CR/LF characters Not shown in the comparison detail

16.4 Active regular expressions

No regular expressions were active.

16.5 Comparison detail

  1   MCCF EDI T AS US433/U S434
  2   System Des ign Docume nt
  3  
  4  
  5  
  6  
  7  
  8   Department  of Vetera ns Affairs
  9   September  2017
  10   Version 1. 01
  11   User Story  Number: U SRX-31A/US RX-31B
  12   User Story  Name: Pre scription  Label Func tionality  Enhancemen ts. Label  Deficienci es when Ed iting.
  13   Product Ba cklog ID:  195
  14   Backlog Pr iority: 11
  15   Initial Si zing Estim ate:
  16   Rational I D: 828297
  17   Rally ID:  US433/US43 4
  18  
  19   Design – S ummary
  20   Updates ar e needed t o resolve  label prin ting defic iencies in  VistA. Th is SDD con tains the  required u pdates for  the scena rios detai led in the  functiona l design d ocuments f or US433 a nd US434.  The specif ic areas i n VistA th at will be  addressed  in this S DD are:
  21   Edit Presc riptions,  Option PSO  RXEDIT (U S433)
  22   Medication  Profile
  23   Action ED  Edit (US43 3)
  24   Action RES  Resubmit  (US434)
  25   Worklist
  26   Action ED  Edit Rx (U S433)
  27   Action CLA  Submit Cl arif. Code  (US434)
  28   Action OVR  Submit Ov erride Cod es (US434)
  29   Action PA  Submit Pri or Auth. ( US434)
  30   Action RES  Resubmit  Claim (US4 34)
  31   Action SMA  Submit Mu lt. Action s (US434)
  32   For claims  that have  been rele ased, the  Reprint La bel prompt  should no t be displ ayed to th e user. Th is will be  true for  all of the  options a nd actions  updated w ith US433/ US434, reg ardless of  patient e ligibility
  33   List of Co mponents:
  34   Routine: P SOBPSU3
  35   Routine: P SOREJP2
  36   Routine: P SORXED
  37   Routine: P SORXEDT
  38  
  39   Design – D etail
  40   Within the  Medicatio n Profile  Option, th e RES Resu bmit Actio n does not  prompt th e user wit h the Labe l and Queu e prompts  for payabl e claims t hat are no t released . A call t o PTLBL^PS OREJP2 wil l be added . The call ed subrout ine execut es various  checks to  determine  if the Pr int Label  prompt sho uld be dis played to  the user.  If the pro mpt is dis played and  the user  responds w ith YES, t he claim w ill be add ed to the  Queue List  for print ing.
  41   Subroutine  Name
  42   RES^PSOBPS U3
  43   Enhancemen t Category
  44    New
  45    Modify
  46    Delete
  47    No Change
  48   Story
  49   US434
  50   Related Me nu Options  or ListMa n Actions
  51   Medication  Profile,  Action RES  Resubmit
  52   Related Ro utines
  53   This Subro utine is C alled By
  54   This Subro utine Call s
  55  
  56   PSO HIDDEN  ACTIONS:  RES Resubm it Action
  57   $$ELIGDISP ^PSOREJP1
  58   $$PTLBL^PS OREJP2
  59   $$VAL^BPSP SOU1
  60   ECMESND^PS OBPSU1
  61   PAUSE^VALM 1
  62   Related In tegration  Control Re gistration s (ICRs)
  63   n/a
  64   Data Passi ng
  65    Parameter  Input
  66    Parameter  Output
  67    Function  Return Val ue
  68    Global Mo dified
  69   Input Attr ibute Name  and Defin ition
  70   Name: RXIE N
  71   Definition : Prescrip tion IEN
  72    New       Modify       Delete       No Cha nge
  73   Name: DFN
  74   Definition : Default  Fill Numbe r
  75    New       Modify       Delete       No Cha nge
  76   Output Att ribute Nam e and Defi nition
  77   Name: n/a
  78   Definition
  79    New       Modify       Delete       No Cha nge
  80   Current Lo gic
  81  
  82   PSOBPSU3 ; ALB/CFS -  BPS (ECME)  Utilities  3 ;08/27/ 15
  83    ;;7.0;OUT PATIENT PH ARMACY;**4 48**;DEC 1 997;Build  25
  84  
  85  
  86  
  87   RES(RXIEN, DFN) ; Res ubmit a cl aim action  from PSO  HIDDEN ACT IONS
  88    N ACTION, DIRUT,PSOC OB,PSOFILL ,PSOFL,PSO FLZ,PSOELI G,REVREAS, VALID
  89    S PSOFILL =$$FILL(RX IEN,DFN,.P SOFL)
  90    I $D(DIRU T) G END
  91    I PSOFILL ="" W !!," No claim w as ever su bmitted fo r this pre scription.  Cannot re submit." D  PAUSE^VAL M1 G END
  92    S PSOELIG =$$ELIGDIS P^PSOREJP1 (RXIEN,PSO FILL)
  93    ; Validat e the clai m.
  94    S VALID=$ $VAL^BPSPS OU1(RXIEN, PSOFILL,PS OELIG,"RES ",.PSOCOB, .REVREAS)  ;DBIA #624 8
  95    I 'VALID  G END
  96    I $$RXDEL (RXIEN,PSO FILL) D  D  PAUSE^VAL M1 G END
  97    . W !!,"T he claim c annot be R esubmitted  since it  has been d eleted in  Pharmacy."
  98    ; Resubmi t the clai m to ECME
  99    D ECMESND ^PSOBPSU1( RXIEN,PSOF ILL,,"ED", ,,"RESUBMI T FROM RX  EDIT SCREE N","",""," ","","","" ,"",$G(PSO COB))
  100    D PAUSE^V ALM1
  101    S VALMBCK ="R"
  102    Q
  103  
  104   Modified L ogic (Chan ges are hi ghlighted)
  105  
  106    PSOBPSU3  ;ALB/CFS -  BPS (ECME ) Utilitie s 3 ;08/27 /15
  107    ;;7.0;OUT PATIENT PH ARMACY;**4 48,482**;D EC 1997;Bu ild 25
  108  
  109  
  110  
  111   RES(RXIEN, DFN) ; Res ubmit a cl aim action  from PSO  HIDDEN ACT IONS
  112    N ACTION, DIRUT,PSOC OB,PSOFILL ,PSOFL,PSO FLZ,PSOELI G,REVREAS, VALID
  113    S PSOFILL =$$FILL(RX IEN,DFN,.P SOFL)
  114    I $D(DIRU T) G END
  115    I PSOFILL ="" W !!," No claim w as ever su bmitted fo r this pre scription.  Cannot re submit." D  PAUSE^VAL M1 G END
  116    S PSOELIG =$$ELIGDIS P^PSOREJP1 (RXIEN,PSO FILL)
  117    ; Validat e the clai m.
  118    S VALID=$ $VAL^BPSPS OU1(RXIEN, PSOFILL,PS OELIG,"RES ",.PSOCOB, .REVREAS)  ;DBIA #624 8
  119    I 'VALID  G END
  120    I $$RXDEL (RXIEN,PSO FILL) D  D  PAUSE^VAL M1 G END
  121    . W !!,"T he claim c annot be R esubmitted  since it  has been d eleted in  Pharmacy."
  122    ; Resubmi t the clai m to ECME
  123    D ECMESND ^PSOBPSU1( RXIEN,PSOF ILL,,"ED", ,,"RESUBMI T FROM RX  EDIT SCREE N","",""," ","","","" ,"",$G(PSO COB))
  124    I $$PTLBL ^PSOREJP2( RXIEN,PSOF ILL) S PSO RX("PSOL", 1)=RXIEN_" ,"  ; Add  Rx to Queu e List
  125    D PAUSE^V ALM1
  126    S VALMBCK ="R"
  127    Q 
  128    
  129  
  130   PTLBL cont ains a ser ies of che cks to det ermine if  the “Print  Label” or  “Reprint  Label” pro mpt should  be issued  to the us er. Curren tly if an  unreleased , payable  claim is e dited, the  prompt is  not displ ayed to th e user. Th e user sho uld have t he ability  to reprin t the labe l (upon ed iting) sin ce the pre scription  has not be en release d. An addi tional che ck will be  added to  correct th is issue.
  131   Currently  the code a lso checks  eligibili ty when de termining  if the Pri nt/Reprint  label sho uld be dis played to  the user.  This check  is no lon ger valid  and will b e removed.  
  132   Multiple a ctions wit hin the Wo rklist Opt ion curren tly presen t the user  with the  Reprint La bel prompt  for claim s that hav e been rel eased. Wit h this upd ate, the u ser will n o longer b e prompted  with the  Reprint La bel prompt  for claim s that are  released.  The follo wing Workl ist Action s will hav e this cha nge: CLA,  OVR, PA, R ES and SMA .
  133  
  134   Subroutine  Name
  135   PTLBL^PSOR EJP2
  136   Enhancemen t Category
  137    New
  138    Modify
  139    Delete
  140    No Change
  141   Story
  142   US433 and  US434
  143   Related Me nu Options  or ListMa n Actions
  144   Medication  Profile a nd Worklis t Option
  145   Related Ro utines
  146   This Subro utine is C alled By
  147   This Subro utine Call s
  148  
  149   FILL^PSORE JP3
  150   LBLCHK^PSO RXED
  151   SEND^PSORE JP3
  152   $$FIND^PSO REJUT
  153   $$GET1^DIQ
  154   $$RXRLDT^P SOBPSUT
  155   $$TRIC^PSO REJP1
  156   Related In tegration  Control Re gistration s (ICRs)
  157   n/a
  158   Data Passi ng
  159    Parameter  Input
  160    Parameter  Output
  161    Function  Return Val ue
  162    Global Mo dified
  163   Input Attr ibute Name  and Defin ition
  164   Name: RX
  165   Definition : Prescrip tion RX
  166    New       Modify       Delete       No Cha nge
  167   Name: RFL
  168   Definition : Refill
  169    New       Modify       Delete       No Cha nge
  170   Output Att ribute Nam e and Defi nition
  171   Name: n/a
  172   Definition
  173    New       Modify       Delete       No Cha nge
  174   Current Lo gic
  175  
  176   PSOREJP2 ; BIRM/MFR -  Third Par ty Rejects  View/Proc ess ;04/28 /05
  177    ;;7.0;OUT PATIENT PH ARMACY;**1 48,247,260 ,287,289,3 58,385,403 ,421,427,4 48**;DEC 1 997;Build  25
  178  
  179  
  180  
  181   PTLBL(RX,R FL) ; Retu rns whethe r the user  should be  prompted  for 'Print  Label?' o r not
  182    N PTLBL,C MP,LBL,REP RINT
  183    N PSOTRIC  S PSOTRIC ="",PSOTRI C=$$TRIC^P SOREJP1(RX ,RFL,.PSOT RIC)
  184    I $$FIND^ PSOREJUT(R X,RFL) Q 0        ; H as OPEN/UN RESOLVED 3 rd pary pa yer reject
  185    I $$GET1^ DIQ(52,RX, 100,"I") Q  0     ; R x status n ot ACTIVE
  186    I $$RXRLD T^PSOBPSUT (RX,RFL),' PSOTRIC Q  0     ; Rx  Released
  187    ; - CMOP  Rx fill?
  188    S PTLBL=1 ,CMP=0
  189    F  S CMP= $O(^PSRX(R X,4,CMP))  Q:'CMP  D   Q:'PTLBL
  190    . I +$$GE T1^DIQ(52. 01,CMP_"," _RX,2,"I") =RFL S PTL BL=0
  191    I 'PTLBL  Q 0
  192    ; - Label  already p rinted for  Rx fill?
  193    S LBL=0
  194    F  S LBL= $O(^PSRX(R X,"L",LBL) ) Q:'LBL   D  Q:'PTLB L
  195    . I +$$GE T1^DIQ(52. 032,LBL_", "_RX,1,"I" )'=RFL Q
  196    . I $G(PS OTRIC)&($$ RXRLDT^PSO BPSUT(RX,R FL)) S REP RINT=1 Q
  197    . I $$GET 1^DIQ(52.0 32,LBL_"," _RX,4,"I")  Q
  198    . I $$GET 1^DIQ(52.0 32,LBL_"," _RX,2)["IN TERACTION"  Q
  199    . S PTLBL =0
  200    ;
  201    I PTLBL D
  202    . N DIR,D IRUT,Y
  203    . W ! S D IR(0)="Y", DIR("A")=$ S('$G(REPR INT):"Prin t Label",1 :"Reprint  Label"),DI R("B")="YE S"
  204    . D ^DIR  I $G(Y)=0! $D(DIRUT)  S PTLBL=0  Q
  205    ;
  206    Q PTLBL
  207  
  208   Modified L ogic (Chan ges are hi ghlighted)
  209  
  210   PSOREJP2 ; BIRM/MFR -  Third Par ty Rejects  View/Proc ess ;04/28 /05
  211    ;;7.0;OUT PATIENT PH ARMACY;**1 48,247,260 ,287,289,3 58,385,403 ,421,427,4 48,482**;D EC 1997;Bu ild 25
  212  
  213  
  214  
  215   PTLBL(RX,R FL) ; Cond itionally  prompts us er with ‘P rint Label ?’ prompt.
  216    ; If User  responds  YES to ‘Pr int Label’  value of  1 is retur ned.
  217    ; If User  responds  NO to ‘Pri nt Label’  value of 0  is return ed.
  218    N PTLBL,C MP,LBL,REP RINT
  219    N PSOTRIC  S PSOTRIC ="",PSOTRI C=$$TRIC^P SOREJP1(RX ,RFL,.PSOT RIC)
  220    I $$FIND^ PSOREJUT(R X,RFL) Q 0        ; H as OPEN/UN RESOLVED 3 rd pary pa yer reject
  221    I $$GET1^ DIQ(52,RX, 100,"I") Q  0     ; R x status n ot ACTIVE
  222    I $$RXRLD T^PSOBPSUT (RX,RFL),' PSOTRIC Q  0     ; Rx  Released
  223    ; - CMOP  Rx fill?
  224    S PTLBL=1 ,CMP=0
  225    F  S CMP= $O(^PSRX(R X,4,CMP))  Q:'CMP  D   Q:'PTLBL
  226    . I +$$GE T1^DIQ(52. 01,CMP_"," _RX,2,"I") =RFL S PTL BL=0
  227    I 'PTLBL  Q 0
  228    ; - Label  already p rinted for  Rx fill?
  229    S LBL=0
  230    F  S LBL= $O(^PSRX(R X,"L",LBL) ) Q:'LBL   D  Q:'PTLB L
  231    . I +$$GE T1^DIQ(52. 032,LBL_", "_RX,1,"I" )'=RFL Q
  232    . I $G(PS OTRIC)&($$ RXRLDT^PSO BPSUT(RX,R FL)) S REP RINT=1 Q
  233    . I '$$RX RLDT^PSOBP SUT(RX,RFL ),+$$GET1^ DIQ(52.032 ,LBL_","_R X,1,"I")=R FL S REPRI NT=1 Q
  234    . I $$GET 1^DIQ(52.0 32,LBL_"," _RX,4,"I")  Q
  235    . I $$GET 1^DIQ(52.0 32,LBL_"," _RX,2)["IN TERACTION"  Q
  236    . S PTLBL =0
  237    ;
  238    I PTLBL D
  239    . N DIR,D IRUT,Y
  240    . W ! S D IR(0)="Y", DIR("A")=$ S('$G(REPR INT):"Prin t Label",1 :"Reprint  Label"),DI R("B")="YE S"
  241    . D ^DIR  I $G(Y)=0! $D(DIRUT)  S PTLBL=0  Q
  242    ;
  243    Q PTLBL  
  244  
  245  
  246   The existi ng logic r eacts oppo site of th e user’s r esponse. I f the user  says YES  to reprint  label, th e device p rompt is n ot display ed. If the  user says  NO to rep rint label , the devi ce prompt  is display ed to the  user. This  update wi ll correct  that logi c.
  247   Subroutine  Name
  248   ASKL^PSORX ED
  249   Enhancemen t Category
  250    New
  251    Modify
  252    Delete
  253    No Change
  254   Story
  255   US433
  256   Related Me nu Options  or ListMa n Actions
  257   n/a
  258   Related Ro utines
  259   This Subro utine is C alled By
  260   This Subro utine Call s
  261  
  262   SKPTRIC^PS ORXED1
  263   ^DIR
  264   Related In tegration  Control Re gistration s (ICRs)
  265   n/a
  266   Data Passi ng
  267    Parameter  Input
  268    Parameter  Output
  269    Function  Return Val ue
  270    Global Mo dified
  271   Input Attr ibute Name  and Defin ition
  272   Name: n/a
  273   Definition
  274    New       Modify       Delete       No Cha nge
  275   Output Att ribute Nam e and Defi nition
  276   Name: n/a
  277   Definition
  278    New       Modify       Delete       No Cha nge
  279   Current Lo gic
  280  
  281   ASKL ;
  282    W ! K DIR  S DIR("?" ,1)="You h ave edited  a fill th at has alr eady been  released.  Do you wan t to",DIR( "?",2)="in clude this  prescript ion as one  of the pr escription s to be ac ted upon", DIR("?",3) ="at the l abel promp t."
  283    S DIR("?" )="Enter ' Yes' to ge nerate a r eprint lab el request ."
  284    S DIR(0)= "Y",DIR("A ")="The la st fill ha s been rel eased, do  you want a  reprint l abel",DIR( "B")="Y" D  ^DIR K DI R I Y=1 S  PSOEDITL=$ S($G(PSOTR IC)&(Y'=1) :1,1:0) Q
  285    S PSOEDIT L=1
  286    Q
  287  
  288   Modified L ogic (Chan ges are hi ghlighted)
  289  
  290   ASKL ;
  291    W ! K DIR  S DIR("?" ,1)="You h ave edited  a fill th at has alr eady been  released.  Do you wan t to",DIR( "?",2)="in clude this  prescript ion as one  of the pr escription s to be ac ted upon", DIR("?",3) ="at the l abel promp t."
  292    S DIR("?" )="Enter ' Yes' to ge nerate a r eprint lab el request ."
  293    S DIR(0)= "Y",DIR("A ")="The la st fill ha s been rel eased, do  you want a  reprint l abel",DIR( "B")="Y" D  ^DIR K DI R I Y'=1 S  PSOEDITL= 0 Q ; User  did not r eply as “Y ES” - Don' t prompt f or label d evice.
  294    S PSOEDIT L=1
  295    Q
  296      
  297  
  298   Depending  on where t his logic  is called  from, the  Queue prom pt is disp layed to t he user. I t should b e displaye d if editi ng from th e Medicati on Profile  option. I t should n ot be disp layed if e diting fro m the Work list optio n. The upd ate below  adds addit ional logi c to corre ct this is sue.
  299   Subroutine  Name
  300   LBLCHK^PSO RXED
  301   Enhancemen t Category
  302    New
  303    Modify
  304    Delete
  305    No Change
  306   Story
  307   US433
  308   Related Me nu Options  or ListMa n Actions
  309   Medication  Profile a nd Worklis t Edit Act ions
  310   Related Ro utines
  311   This Subro utine is C alled By
  312   This Subro utine Call s
  313  
  314   LOG^PSORXE D
  315   $$RXRLDT^P SOBPSUT
  316   $$PTLBL^PS OREJP2
  317   PRINT^PSOR EJP3
  318   Related In tegration  Control Re gistration s (ICRs)
  319   n/a
  320   Data Passi ng
  321    Parameter  Input
  322    Parameter  Output
  323    Function  Return Val ue
  324    Global Mo dified
  325   Input Attr ibute Name  and Defin ition
  326   Name: n/a
  327   Definition
  328    New       Modify       Delete       No Cha nge
  329   Output Att ribute Nam e and Defi nition
  330   Name: n/a
  331   Definition
  332    New       Modify       Delete       No Cha nge
  333   Current Lo gic
  334  
  335   LBLCHK ;
  336    I '$$RXRL DT^PSOBPSU T(PSORXED( "IRXN"),PS OEDITF) D
  337    .I $$PTLB L^PSOREJP2 (PSORXED(" IRXN"),PSO EDITF) D P RINT^PSORE JP3(PSORXE D("IRXN"), PSOEDITF)
  338    Q
  339  
  340   Modified L ogic (Chan ges are hi ghlighted)
  341  
  342   LBLCHK ;
  343    ; PSOEDIT L flag is  used to de termine if  the Queue  prompt wi ll be disp layed
  344    ; to the  user.
  345    ; PSORX(“ NOLABEL”)  is used to  determine  if the La bel Prompt  should be  displayed
  346    ; to the  user by ca lling rout ine. 
  347    S PSOEDIT L=0
  348    I '$$RXRL DT^PSOBPSU T(PSORXED( "IRXN"),PS OEDITF) D
  349    . I $$PTL BL^PSOREJP 2(PSORXED( "IRXN"),PS OEDITF) D
  350    . . S PSO RX("NOLABE L")=0
  351    . . I $D( PSORX("QFL G")) S PSO EDITL=1
  352    . . E  D  PRINT^PSOR EJP3(PSORX ED("IRXN") ,PSOEDITF)
  353    . E  S PS ORX("NOLAB EL")=1
  354    Q
  355      
  356  
  357   Update log ic which d etermines  if Label a nd Queue p rompts sho uld be pre sented to  the user u pon Editin g via Medi cation Pro file and W orklist.
  358   Subroutine  Name
  359   LOG^PSORXE D
  360   Enhancemen t Category
  361    New
  362    Modify
  363    Delete
  364    No Change
  365   Story
  366   US433
  367   Related Me nu Options  or ListMa n Actions
  368   Medication  Profile a nd Worklis t Edit Act ions
  369   Related Ro utines
  370   This Subro utine is C alled By
  371   This Subro utine Call s
  372  
  373   EX^PSOORED T
  374   $$RXRLDT^P SOBPSUT
  375   $$TRIC^PSO REJP1
  376   NOW^%DTC
  377   Related In tegration  Control Re gistration s (ICRs)
  378   n/a
  379   Data Passi ng
  380    Parameter  Input
  381    Parameter  Output
  382    Function  Return Val ue
  383    Global Mo dified
  384   Input Attr ibute Name  and Defin ition
  385   Name: n/a
  386   Definition
  387    New       Modify       Delete       No Cha nge
  388   Output Att ribute Nam e and Defi nition
  389   Name: n/a
  390   Definition
  391    New       Modify       Delete       No Cha nge
  392   Current Lo gic
  393  
  394   PSORXED ;I HS/DSD/JCM  - edit rx  utility ; 8/18/10 3: 16pm
  395    ;;7.0;OUT PATIENT PH ARMACY;**2 ,16,21,26, 56,71,125, 201,246,28 9,298,366, 385,403,42 1**;DEC 19 97;Build 1 5
  396  
  397  
  398  
  399   LOG K PSFR OM S DA=PS ORXED("IRX N"),(PSRX0 ,RX0)=PSOR XED("RX0") ,QTY=$P(RX 0,"^",7),Q TY=QTY-$P( ^PSRX(DA,0 ),"^",7) K  ZD(DA) S: '$O(^PSRX( DA,1,0)) Z D(DA)=$P(^ PSRX(DA,2) ,"^",2)
  400    N PSOTRIC  S PSOTRIC ="",PSOTRI C=$$TRIC^P SOREJP1(PS ORXED("IRX N"),0,.PSO TRIC)
  401    S COM=""  F I=3,4,5: 1:13,17 I  $P(PSRX0," ^",I)'=$P( ^PSRX(DA,0 ),"^",I) S  PSI=$S(I= 13:1,1:I), COM=COM_$P (^DD(52,PS I,0),"^")_ " ("_$P(PS RX0,"^",I) _"),"
  402    ;
  403    N PSOFILD AT S PSOFI LDAT=0   ;  fill date  edit flag
  404    I $P(PSOR XED("RX2") ,"^",2)'=$ P(^PSRX(DA ,2),"^",2)  S COM=COM _$P(^DD(52 ,22,0),"^" )_" ("_$P( PSORXED("R X2"),"^",2 )_"),",PSO FILDAT=1      ; set f lag indica ting the o riginal fi ll date wa s edited
  405    I $P(PSOR XED("RX3") ,"^",7)'=$ P(^PSRX(DA ,3),"^",7)  S COM=COM _$P(^DD(52 ,12,0),"^" )_" ("_$P( PSORXED("R X3"),"^",7 )_"),"
  406    I PSOSIG' =$P($G(^PS RX(DA,"SIG ")),"^") S  COM=COM_$ P(^DD(52,1 0,0),"^")_ " ("_PSOSI G_"),"
  407    ;*298 Tra ck PI and  Oth Lang P I
  408    I PSOPINS '=$G(^PSRX (DA,"INS") ) S COM=CO M_$P(^DD(5 2,114,0)," ^")_" ("_P SOPINS_"), "
  409    I PSOOINS '=$G(^PSRX (DA,"INSS" )) S COM=C OM_$P(^DD( 52,114.1,0 ),"^")_" ( "_PSOOINS_ "),"
  410    I PSOTRN' =$G(^PSRX( DA,"TN"))  S COM=COM_ $P(^DD(52, 6.5,0),"^" )_" ("_PSO TRN_"),"
  411    D FILL
  412    I PSOTRIC &('$$RXRLD T^PSOBPSUT (PSORXED(" IRXN"),PSO EDITF)),CO M="" D LBL CHK G LOGX  ; labels  for unrele ased TRICA RE/CHAMPVA  resolved  claims; wh en COM'=""  label alw ays printe d
  413    I PSOTRIC &(COM="")  D LBL D AS KL:PSOEDIT L G:'PSOED ITL LOGX G  LOG1
  414    G:COM=""  LOGX K PSR X0 S X=$S( $D(PSOCLC) :PSOCLC,1: DUZ)
  415    D LBL D:$ G(PSOEDITL )=2&($P($G (^PSRX(DA, "STA")),"^ ")'=5)&('$ G(RXRP(DA) ))&('$G(PS OSIGFL)) A SKL
  416    S K=1,D1= 0 F Z=0:0  S Z=$O(^PS RX(DA,"A", Z)) Q:'Z   S D1=Z,K=K +1
  417    S D1=D1+1  S:'($D(^P SRX(DA,"A" ,0))#2) ^( 0)="^52.3D A^^^" S ^( 0)=$P(^(0) ,"^",1,2)_ "^"_D1_"^" _K
  418    ;
  419    ;PSO*7*36 6
  420    D NOW^%DT C S ^PSRX( DA,"A",D1, 0)=%_"^E^" _$G(DUZ)_" ^0^"_COM
  421   LOG1 ;
  422    I QTY,$P( ^PSRX(DA,2 ),"^",13)  S ^PSDRUG( $P(^PSRX(D A,0),"^",6 ),660.1)=$ S($D(^PSDR UG(+$P(^PS RX(DA,0)," ^",6),660. 1)):^(660. 1)+QTY,1:Q TY)
  423    S:$P(RX0, "^",6)'=$P (^PSRX(DA, 0),"^",6)  ^PSDRUG(+$ P(^PSRX(DA ,0),"^",6) ,660.1)=$S ($D(^PSDRU G(+$P(RX0, "^",6),660 .1)):^(660 .1)+$P(RX0 ,"^",7),1: $P(RX0,"^" ,7))
  424    S RX0=^PS RX(DA,0),R X2=^(2),J= DA,OEXDT=+ $P(RX2,"^" ,6) D ^PSO EXDT S NEX DT=+$P(RX2 ,"^",6) I  OEXDT'=NEX DT D
  425    .K ^PSRX( "AG",OEXDT ,DA) S ^PS RX("AG",NE XDT,DA)=""
  426    .S D=+$P( RX0,"^",2)  K ^PS(55, D,"P","A", OEXDT,DA)  S ^PS(55,D ,"P","A",N EXDT,DA)=" "
  427    K D,OEXDT ,NEXDT
  428    ; 
  429    ; Do not  add RX to  the label  list when  there are:
  430    ;   1) Un resolved D UR/Refill  Too Soon/R RR rejects
  431    ;   2) Un resolved T RICARE/CHA MPVA rejec ts
  432    ;   3) TR ICARE/CHAM PVA claims  that are  IN PROGRES S
  433    ; But if  the Fill D ate was mo dified the n bypass t hese check s and allo w to updat e the labe l list  -  PSO*7*403
  434    I 'PSOFIL DAT,$$ECME CHK^PSOREJ U3(DA,$G(P SOEDITF))  G LOGX
  435    ;
  436    G:+$P(^PS RX(J,"STA" ),"^")!($G (PSOEDITL) =1&('$G(PS OTRIC))) L OGX S RXFL (PSORXED(" IRXN"))=$S ($G(PSOEDI TF):$G(PSO EDITF),1:0 ) I $G(PSO RX("PSOL", 1))']"" S  PSORX("PSO L",1)=PSOR XED("IRXN" )_"," D SE TRP G LOGX
  437    G:$G(PSOE DITL)=1&(' $G(PSOTRIC )) LOGX
  438    ;
  439    F PSOX1=0 :0 S PSOX1 =$O(PSORX( "PSOL",PSO X1)) Q:'PS OX1  S PSO X2=PSOX1
  440    I $L(PSOR X("PSOL",P SOX2))+$L( PSORXED("I RXN"))<220  D  G LOGX
  441    .I PSORX( "PSOL",PSO X2)'[PSORX ED("IRXN") _"," S PSO RX("PSOL", PSOX2)=PSO RX("PSOL", PSOX2)_PSO RXED("IRXN ")_"," D S ETRP
  442    E  I $G(P SORX("PSOL ",PSOX2+1) )'[PSORXED ("IRXN")_" ," S PSORX ("PSOL",PS OX2+1)=PSO RXED("IRXN ")_"," D S ETRP   ;;P SO*7*246
  443   LOGX K PSO EDITF,PSOE DITR,PSOED ITL D:$G(R FED) ^PSOR XED1
  444    Q
  445  
  446   Modified L ogic (Chan ges are hi ghlighted)
  447  
  448   PSORXED ;I HS/DSD/JCM  - edit rx  utility ; 8/18/10 3: 16pm
  449    ;;7.0;OUT PATIENT PH ARMACY;**2 ,16,21,26, 56,71,125, 201,246,28 9,298,366, 385,403,42 1,482**;DE C 1997;Bui ld 15
  450  
  451  
  452  
  453   LOG K PSFR OM S DA=PS ORXED("IRX N"),(PSRX0 ,RX0)=PSOR XED("RX0") ,QTY=$P(RX 0,"^",7),Q TY=QTY-$P( ^PSRX(DA,0 ),"^",7) K  ZD(DA) S: '$O(^PSRX( DA,1,0)) Z D(DA)=$P(^ PSRX(DA,2) ,"^",2)
  454    N PSOTRIC  S PSOTRIC ="",PSOTRI C=$$TRIC^P SOREJP1(PS ORXED("IRX N"),0,.PSO TRIC)
  455    S COM=""  F I=3,4,5: 1:13,17 I  $P(PSRX0," ^",I)'=$P( ^PSRX(DA,0 ),"^",I) S  PSI=$S(I= 13:1,1:I), COM=COM_$P (^DD(52,PS I,0),"^")_ " ("_$P(PS RX0,"^",I) _"),"
  456    ;
  457    N PSOFILD AT S PSOFI LDAT=0   ;  fill date  edit flag
  458    I $P(PSOR XED("RX2") ,"^",2)'=$ P(^PSRX(DA ,2),"^",2)  S COM=COM _$P(^DD(52 ,22,0),"^" )_" ("_$P( PSORXED("R X2"),"^",2 )_"),",PSO FILDAT=1      ; set f lag indica ting the o riginal fi ll date wa s edited
  459    I $P(PSOR XED("RX3") ,"^",7)'=$ P(^PSRX(DA ,3),"^",7)  S COM=COM _$P(^DD(52 ,12,0),"^" )_" ("_$P( PSORXED("R X3"),"^",7 )_"),"
  460    I PSOSIG' =$P($G(^PS RX(DA,"SIG ")),"^") S  COM=COM_$ P(^DD(52,1 0,0),"^")_ " ("_PSOSI G_"),"
  461    ;*298 Tra ck PI and  Oth Lang P I
  462    I PSOPINS '=$G(^PSRX (DA,"INS") ) S COM=CO M_$P(^DD(5 2,114,0)," ^")_" ("_P SOPINS_"), "
  463    I PSOOINS '=$G(^PSRX (DA,"INSS" )) S COM=C OM_$P(^DD( 52,114.1,0 ),"^")_" ( "_PSOOINS_ "),"
  464    I PSOTRN' =$G(^PSRX( DA,"TN"))  S COM=COM_ $P(^DD(52, 6.5,0),"^" )_" ("_PSO TRN_"),"
  465    D FILL
  466    I PSOTRIC &('$$RXRLD T^PSOBPSUT (PSORXED(" IRXN"),PSO EDITF)),CO M="" D LBL CHK G:'PSO EDITL LOGX  G LOG1
  467    I PSOTRIC &(COM="")  D LBL D AS KL:PSOEDIT L G:'PSOED ITL LOGX G  LOG1
  468    G:COM=""  LOGX K PSR X0 S X=$S( $D(PSOCLC) :PSOCLC,1: DUZ)
  469    D LBL D:$ G(PSOEDITL )=2&($P($G (^PSRX(DA, "STA")),"^ ")'=5)&('$ G(RXRP(DA) ))&('$G(PS OSIGFL)) A SKL
  470    S K=1,D1= 0 F Z=0:0  S Z=$O(^PS RX(DA,"A", Z)) Q:'Z   S D1=Z,K=K +1
  471    S D1=D1+1  S:'($D(^P SRX(DA,"A" ,0))#2) ^( 0)="^52.3D A^^^" S ^( 0)=$P(^(0) ,"^",1,2)_ "^"_D1_"^" _K
  472    ;
  473    ;PSO*7*36 6
  474    D NOW^%DT C S ^PSRX( DA,"A",D1, 0)=%_"^E^" _$G(DUZ)_" ^0^"_COM
  475   LOG1 ;
  476    I QTY,$P( ^PSRX(DA,2 ),"^",13)  S ^PSDRUG( $P(^PSRX(D A,0),"^",6 ),660.1)=$ S($D(^PSDR UG(+$P(^PS RX(DA,0)," ^",6),660. 1)):^(660. 1)+QTY,1:Q TY)
  477    S:$P(RX0, "^",6)'=$P (^PSRX(DA, 0),"^",6)  ^PSDRUG(+$ P(^PSRX(DA ,0),"^",6) ,660.1)=$S ($D(^PSDRU G(+$P(RX0, "^",6),660 .1)):^(660 .1)+$P(RX0 ,"^",7),1: $P(RX0,"^" ,7))
  478    S RX0=^PS RX(DA,0),R X2=^(2),J= DA,OEXDT=+ $P(RX2,"^" ,6) D ^PSO EXDT S NEX DT=+$P(RX2 ,"^",6) I  OEXDT'=NEX DT D
  479    .K ^PSRX( "AG",OEXDT ,DA) S ^PS RX("AG",NE XDT,DA)=""
  480    .S D=+$P( RX0,"^",2)  K ^PS(55, D,"P","A", OEXDT,DA)  S ^PS(55,D ,"P","A",N EXDT,DA)=" "
  481    K D,OEXDT ,NEXDT
  482    ; 
  483    ; Do not  add RX to  the label  list when  there are:
  484    ;   1) Un resolved D UR/Refill  Too Soon/R RR rejects
  485    ;   2) Un resolved T RICARE/CHA MPVA rejec ts
  486    ;   3) TR ICARE/CHAM PVA claims  that are  IN PROGRES S
  487    ; But if  the Fill D ate was mo dified the n bypass t hese check s and allo w to updat e the labe l list  -  PSO*7*403
  488    I 'PSOFIL DAT,$$ECME CHK^PSOREJ U3(DA,$G(P SOEDITF))  G LOGX
  489    ;
  490    G:+$P(^PS RX(J,"STA" ),"^")!($G (PSOEDITL) =1&('$G(PS OTRIC))) L OGX S RXFL (PSORXED(" IRXN"))=$S ($G(PSOEDI TF):$G(PSO EDITF),1:0 ) I $G(PSO RX("PSOL", 1))']"" S  PSORX("PSO L",1)=PSOR XED("IRXN" )_"," D SE TRP G LOGX
  491    G:$G(PSOE DITL)=1&(' $G(PSOTRIC )) LOGX
  492    ;
  493    F PSOX1=0 :0 S PSOX1 =$O(PSORX( "PSOL",PSO X1)) Q:'PS OX1  S PSO X2=PSOX1
  494    I $L(PSOR X("PSOL",P SOX2))+$L( PSORXED("I RXN"))<220  D  G LOGX
  495    .I PSORX( "PSOL",PSO X2)'[PSORX ED("IRXN") _"," S PSO RX("PSOL", PSOX2)=PSO RX("PSOL", PSOX2)_PSO RXED("IRXN ")_"," D S ETRP
  496    E  I $G(P SORX("PSOL ",PSOX2+1) )'[PSORXED ("IRXN")_" ," S PSORX ("PSOL",PS OX2+1)=PSO RXED("IRXN ")_"," D S ETRP   ;;P SO*7*246
  497   LOGX K PSO EDITF,PSOE DITR,PSOED ITL D:$G(R FED) ^PSOR XED1
  498    Q
  499     
  500  
  501   EPH^PSORXE DT is call ed when ed iting a cl aim via th e Worklist  option. I n this sit uation, th e Queue pr ompt shoul d not be d isplayed t o the user . The upda ted logic  verifies t he claim i s not rele ased and e nsures the  label pro mpts to th e user exe cute accor dingly bas ed on the  user’s res ponse to t he “Reprin t Label” p rompt.
  502   Subroutine  Name
  503   EPH^PSORXE DT
  504   Enhancemen t Category
  505    New
  506    Modify
  507    Delete
  508    No Change
  509   Story
  510   US433
  511   Related Me nu Options  or ListMa n Actions
  512   Worklist E dit Action
  513   Related Ro utines
  514   This Subro utine is C alled By
  515   This Subro utine Call s
  516  
  517   EDT^PSOREJ P1
  518   FULLEDT^PS OVER1
  519   $$RXFLDT^P SOBPSUT
  520   ^PSORXL
  521   Related In tegration  Control Re gistration s (ICRs)
  522   n/a
  523   Data Passi ng
  524    Parameter  Input
  525    Parameter  Output
  526    Function  Return Val ue
  527    Global Mo dified
  528   Input Attr ibute Name  and Defin ition
  529   Name: n/a
  530   Definition
  531    New       Modify       Delete       No Cha nge
  532   Output Att ribute Nam e and Defi nition
  533   Name: n/a
  534   Definition
  535    New       Modify       Delete       No Cha nge
  536   Current Lo gic
  537  
  538   PSORXEDT ; BIR/SAB -  edit rx ro utine ;10/ 21/98
  539    ;;7.0;OUT PATIENT PH ARMACY;**2 1,23,44,71 ,146,185,1 48,253,390 ,372,416,3 13,427**;D EC 1997;Bu ild 21
  540  
  541  
  542  
  543   EPH ; - En try for Ep harmacy Rx  Edit (PSO REJP1)
  544    F PSOT1=1 :1 Q:'$D(P SOLIST(PSO T1))  F PS OLST2=1:1: $L(PSOLIST (PSOT1),", ") S ORN=$ P(PSOLIST( PSOT1),"," ,PSOLST2)  D:+ORN PT
  545    ;
  546    ; If vari able PSORE JCT is set , this mea ns the EPH  entry poi nt was cal led by the  EDIT acti on in the  ePharmacy
  547    ;   Rejec t Info Scr een. The v ariable wi ll hold th e RX IEN.  If the Fil l Date is  the curren t date or  in the
  548    ;   futur e (whether  it has be en edited  or not) an d the RX i s not alre ady suspen ded, put t he Rx on t he list
  549    ;   to ge t the QUEU E prompt.  Since the  EDIT actio n only sen ds one RX,  we can ju st set the  array and  not
  550    ;   worry  about app ending to  an exiting  list.
  551    I $G(PSOR EJCT),$$RX FLDT^PSOBP SUT(+PSORE JCT,$P(PSO REJCT,U,2) )'<$$DT^XL FDT,$$GET1 ^DIQ(52,+P SOREJCT_", ",100,"I") '=5 S PSOR X("PSOL",1 )=+PSOREJC T
  552    ;call to  add bingo  board data  to file 5 2.11
  553    K POP,PSO LIST,TM,TM 1 G:'$O(PS ORX("PSOL" ,0)) NX
  554    D:$G(PSOR X("PSOL",1 ))]"" ^PSO RXL K PSOR X G:$G(NOB G) NX
  555   PRF G:'$P( PSOPAR,"^" ,8)!($G(NO PP)="H")!( $G(NOPP)=" S")!('$D(^ TMP("PSOBE DT",$J)))  BBG
  556    I $O(^TMP ("PSOBEDT" ,$J,0)),$P (PSOPAR,"^ ",8) S PSO FROM="NEW" ,PSOION=IO N K RXRS
  557    G:$D(PSOP ROP)&($G(P SOPROP)'=I ON) QUP
  558    I '$D(PSO PROP)!($G( PSOPROP)=I ON) D  G:$ G(POP)!($E (IOST)["C" )!(PSOION= ION) BBG
  559    .S PSOION =ION W !," Profiles m ust be sen t to Print er !!",! K  IOP,%ZIS, IO("Q"),PO P
  560    .S %ZIS=" MNQ",%ZIS( "A")="Sele ct Profile  Device: "  D ^%ZIS K  %ZIS("A")
  561    .Q:$G(POP )!($E(IOST )["C")!(PS OION=ION)   S PSOPROP =ION
  562   QUP S X1=D T,X2=-120  D C^%DTC S  PSODTCUT= X,HOLDRPAS =$G(PSOPRP AS),PSOPRP AS=$P(PSOP AR,"^",13)
  563    F DFN=0:0  S DFN=$O( ^TMP("PSOB EDT",$J,DF N)) Q:'DFN   S PPL=^T MP("PSOBED T",$J,DFN, 0) D
  564    .S ZTRTN= "DQ^PSOPRF ",ZTIO=PSO PROP,ZTDES C="Outpati ent Pharma cy Patient  Profiles" ,ZTDTH=$H
  565    .F G="PSO PAR","PSOD TCUT","PSO PRPAS","DF N","PSOSIT E","NEW1", "NEW11","P SOBMST","P FIO","PPL"  S:$D(@G)  ZTSAVE(G)= ""
  566    .D ^%ZTLO AD
  567    W:$D(ZTSK ) !,"PROFI LE(S) QUEU ED to PRIN T",!! K G, ZTSK D ^%Z ISC
  568    S PSOPRPA S=$G(HOLDR PAS) K:PSO PRPAS']""  PSOPRPAS K  HOLDRPAS
  569   BBG K DFN  F PSODFN=0 :0 S PSODF N=$O(^TMP( "PSOBEDT", $J,PSODFN) ) Q:'PSODF N  I $G(^T MP("PSOBED T",$J,PSOD FN,1)),$D( DISGROUP)  S TM=$P($G (^TMP("PSO BB",$J))," ^"),TM1=$P ($G(^($J)) ,"^",2),PP L=^TMP("PS OBEDT",$J, PSODFN,0)  D ^PSOBING 1
  570   NX ;
  571    K %X,%Y,A CTREF,ACTR EN,D,D0,DA T,DFN,DIC, DIQ,DQ,DRG ,END,FDR,P SOBEDT,TM, TM1,PSOT1, PSOLST2,NO BG,BBFLG,B INGCRT,BIN GRTE,C,CC, CMOP,COM,C T,D1,DI,DR EN,BBRX,PS OFROM,POP, PSORX("QFL G"),IT,PSO ERR,PSOBCK ,PSOBM,PPL
  572    K ^TMP("P SOBEDT",$J ),^TMP("PS OBB",$J),Z TSK,NOPP,V ALMSG,VALM BCK D EOJ
  573   END Q
  574  
  575   Modified L ogic (Chan ges are hi ghlighted)
  576  
  577   PSORXEDT ; BIR/SAB -  edit rx ro utine ;10/ 21/98
  578    ;;7.0;OUT PATIENT PH ARMACY;**2 1,23,44,71 ,146,185,1 48,253,390 ,372,416,3 13,427,482 **;DEC 199 7;Build 21
  579  
  580  
  581  
  582   EPH ; - En try for Ep harmacy Rx  Edit (PSO REJP1)
  583    F PSOT1=1 :1 Q:'$D(P SOLIST(PSO T1))  F PS OLST2=1:1: $L(PSOLIST (PSOT1),", ") S ORN=$ P(PSOLIST( PSOT1),"," ,PSOLST2)  D:+ORN PT
  584    ;
  585    ; If vari able PSORE JCT is set , this mea ns the EPH  entry poi nt was cal led by the  EDIT acti on in the  ePharmacy
  586    ;   Rejec t Info Scr een. The v ariable wi ll hold th e RX IEN.  If the Fil l Date is  the curren t date or  in the
  587    ;   futur e (whether  it has be en edited  or not) an d the RX i s not alre ady suspen ded, put t he Rx on t he list
  588    ;   to ge t the QUEU E prompt.  Since the  EDIT actio n only sen ds one RX,  we can ju st set the  array and  not
  589    ;   worry  about app ending to  an exiting  list.
  590    I $G(PSOR EJCT),'$$R XFLDT^PSOB PSUT(+PSOR EJCT,$P(PS OREJCT,U,2 ))'<$$DT^X LFDT,$$GET 1^DIQ(52,+ PSOREJCT_" ,",100,"I" )'=5,'$G(P SORX("NOLA BEL")) S P SORX("PSOL ",1)=+PSOR EJCT
  591    ;call to  add bingo  board data  to file 5 2.11
  592    K POP,PSO LIST,TM,TM 1 G:'$O(PS ORX("PSOL" ,0)) NX
  593    D:$G(PSOR X("PSOL",1 ))]"" ^PSO RXL K PSOR X G:$G(NOB G) NX
  594   PRF G:'$P( PSOPAR,"^" ,8)!($G(NO PP)="H")!( $G(NOPP)=" S")!('$D(^ TMP("PSOBE DT",$J)))  BBG
  595    I $O(^TMP ("PSOBEDT" ,$J,0)),$P (PSOPAR,"^ ",8) S PSO FROM="NEW" ,PSOION=IO N K RXRS
  596    G:$D(PSOP ROP)&($G(P SOPROP)'=I ON) QUP
  597    I '$D(PSO PROP)!($G( PSOPROP)=I ON) D  G:$ G(POP)!($E (IOST)["C" )!(PSOION= ION) BBG
  598    .S PSOION =ION W !," Profiles m ust be sen t to Print er !!",! K  IOP,%ZIS, IO("Q"),PO P
  599    .S %ZIS=" MNQ",%ZIS( "A")="Sele ct Profile  Device: "  D ^%ZIS K  %ZIS("A")
  600    .Q:$G(POP )!($E(IOST )["C")!(PS OION=ION)   S PSOPROP =ION
  601   QUP S X1=D T,X2=-120  D C^%DTC S  PSODTCUT= X,HOLDRPAS =$G(PSOPRP AS),PSOPRP AS=$P(PSOP AR,"^",13)
  602    F DFN=0:0  S DFN=$O( ^TMP("PSOB EDT",$J,DF N)) Q:'DFN   S PPL=^T MP("PSOBED T",$J,DFN, 0) D
  603    .S ZTRTN= "DQ^PSOPRF ",ZTIO=PSO PROP,ZTDES C="Outpati ent Pharma cy Patient  Profiles" ,ZTDTH=$H
  604    .F G="PSO PAR","PSOD TCUT","PSO PRPAS","DF N","PSOSIT E","NEW1", "NEW11","P SOBMST","P FIO","PPL"  S:$D(@G)  ZTSAVE(G)= ""
  605    .D ^%ZTLO AD
  606    W:$D(ZTSK ) !,"PROFI LE(S) QUEU ED to PRIN T",!! K G, ZTSK D ^%Z ISC
  607    S PSOPRPA S=$G(HOLDR PAS) K:PSO PRPAS']""  PSOPRPAS K  HOLDRPAS
  608   BBG K DFN  F PSODFN=0 :0 S PSODF N=$O(^TMP( "PSOBEDT", $J,PSODFN) ) Q:'PSODF N  I $G(^T MP("PSOBED T",$J,PSOD FN,1)),$D( DISGROUP)  S TM=$P($G (^TMP("PSO BB",$J))," ^"),TM1=$P ($G(^($J)) ,"^",2),PP L=^TMP("PS OBEDT",$J, PSODFN,0)  D ^PSOBING 1
  609   NX ;
  610    K %X,%Y,A CTREF,ACTR EN,D,D0,DA T,DFN,DIC, DIQ,DQ,DRG ,END,FDR,P SOBEDT,TM, TM1,PSOT1, PSOLST2,NO BG,BBFLG,B INGCRT,BIN GRTE,C,CC, CMOP,COM,C T,D1,DI,DR EN,BBRX,PS OFROM,POP, PSORX("QFL G"),IT,PSO ERR,PSOBCK ,PSOBM,PPL
  611    K ^TMP("P SOBEDT",$J ),^TMP("PS OBB",$J),Z TSK,NOPP,V ALMSG,VALM BCK D EOJ
  612   END Q
  613      
  614  
  615   Back Out/R ollback Pr ocedure
  616   This story  includes  modificati ons to exi sting rout ines.
  617   To back ou t this enh ancement,  all the ro utines whi ch are a p art of thi s patch sh ould be ba cked up pr ior to ins tallation.  Reverting  to the pr evious ver sion of th ese routin es would b ack out th is enhance ment. Alte rnatively,  the previ ous versio n of these  routines  could be d istributed  via an em ergency pa tch.