6. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 12/6/2018 10:45:27 AM Eastern Standard 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.

6.1 Files compared

# Location File Last Modified
1 PSU_P2_V2_Build_3.zip PSO_7_524.KID Thu Dec 6 14:45:20 2018 UTC
2 PSU_P2_V2_Build_3.zip PSO_7_524.KID Thu Dec 6 15:34:08 2018 UTC

6.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 3 4464
Changed 2 4
Inserted 0 0
Removed 0 0

6.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

6.4 Active regular expressions

No regular expressions were active.

6.5 Comparison detail

  1   KIDS Distr ibution sa ved on Jun  05, 2018@ 13:14:18
  2   CAS - RXSU 2 Build 3  v3
  3   **KIDS**:P SO*7.0*524 ^
  4  
  5   **INSTALL  NAME**
  6   PSO*7.0*52 4
  7   "BLD",1054 2,0)
  8   PSO*7.0*52 4^OUTPATIE NT PHARMAC Y^0^318060 5^y
  9   "BLD",1054 2,1,0)
  10   ^^14^14^31 80605^
  11   "BLD",1054 2,1,1,0)
  12   Patch PSO* 7.0*524 wi ll enhance  Outpatien t Prescrip tion Proce ssing by
  13   "BLD",1054 2,1,2,0)
  14   adding an  alert to P harmacists  and Pharm acy techni cians duri ng Finishi ng
  15   "BLD",1054 2,1,3,0)
  16   an outpati ent order  that invol ves a Haza rdous to H andle and/ or a Hazar dous
  17   "BLD",1054 2,1,4,0)
  18   to Dispose  drug.
  19   "BLD",1054 2,1,5,0)
  20    
  21   "BLD",1054 2,1,6,0)
  22                                     * NOTICE  *
  23   "BLD",1054 2,1,7,0)
  24      This CA S-RXSU2 pr oject is a n enhancem ent that i ncludes 5  patches th at
  25   "BLD",1054 2,1,8,0)
  26      should  be install ed togethe r:
  27   "BLD",1054 2,1,9,0)
  28      
  29   "BLD",1054 2,1,10,0)
  30                              1. PS S*1*226
  31   "BLD",1054 2,1,11,0)
  32                              2. PS O*7*524
  33   "BLD",1054 2,1,12,0)
  34                              3. PS J*5*364
  35   "BLD",1054 2,1,13,0)
  36                              4. PS B*3*106
  37   "BLD",1054 2,1,14,0)
  38                              5. PS B*3*108     
  39   "BLD",1054 2,4,0)
  40   ^9.64PA^^
  41   "BLD",1054 2,6.3)
  42   12
  43   "BLD",1054 2,"KRN",0)
  44   ^9.67PA^77 9.2^20
  45   "BLD",1054 2,"KRN",.4 ,0)
  46   .4
  47   "BLD",1054 2,"KRN",.4 01,0)
  48   .401
  49   "BLD",1054 2,"KRN",.4 02,0)
  50   .402
  51   "BLD",1054 2,"KRN",.4 03,0)
  52   .403
  53   "BLD",1054 2,"KRN",.5 ,0)
  54   .5
  55   "BLD",1054 2,"KRN",.8 4,0)
  56   .84
  57   "BLD",1054 2,"KRN",3. 6,0)
  58   3.6
  59   "BLD",1054 2,"KRN",3. 8,0)
  60   3.8
  61   "BLD",1054 2,"KRN",9. 2,0)
  62   9.2
  63   "BLD",1054 2,"KRN",9. 8,0)
  64   9.8
  65   "BLD",1054 2,"KRN",9. 8,"NM",0)
  66   ^9.68A^6^5
  67   "BLD",1054 2,"KRN",9. 8,"NM",1,0 )
  68   PSODRG^^0^ B104026958
  69   "BLD",1054 2,"KRN",9. 8,"NM",2,0 )
  70   PSOHLDS1^^ 0^B4988790 0
  71   "BLD",1054 2,"KRN",9. 8,"NM",3,0 )
  72   PSOHLDS2^^ 0^B9825519 2
  73   "BLD",1054 2,"KRN",9. 8,"NM",5,0 )
  74   PSOOREDT^^ 0^B8316480 4
  75   "BLD",1054 2,"KRN",9. 8,"NM",6,0 )
  76   PSOORNE2^^ 0^B1148073 67
  77   "BLD",1054 2,"KRN",9. 8,"NM","B" ,"PSODRG", 1)
  78  
  79   "BLD",1054 2,"KRN",9. 8,"NM","B" ,"PSOHLDS1 ",2)
  80  
  81   "BLD",1054 2,"KRN",9. 8,"NM","B" ,"PSOHLDS2 ",3)
  82  
  83   "BLD",1054 2,"KRN",9. 8,"NM","B" ,"PSOOREDT ",5)
  84  
  85   "BLD",1054 2,"KRN",9. 8,"NM","B" ,"PSOORNE2 ",6)
  86  
  87   "BLD",1054 2,"KRN",19 ,0)
  88   19
  89   "BLD",1054 2,"KRN",19 .1,0)
  90   19.1
  91   "BLD",1054 2,"KRN",10 1,0)
  92   101
  93   "BLD",1054 2,"KRN",40 9.61,0)
  94   409.61
  95   "BLD",1054 2,"KRN",77 1,0)
  96   771
  97   "BLD",1054 2,"KRN",77 9.2,0)
  98   779.2
  99   "BLD",1054 2,"KRN",87 0,0)
  100   870
  101   "BLD",1054 2,"KRN",89 89.51,0)
  102   8989.51
  103   "BLD",1054 2,"KRN",89 89.52,0)
  104   8989.52
  105   "BLD",1054 2,"KRN",89 94,0)
  106   8994
  107   "BLD",1054 2,"KRN","B ",.4,.4)
  108  
  109   "BLD",1054 2,"KRN","B ",.401,.40 1)
  110  
  111   "BLD",1054 2,"KRN","B ",.402,.40 2)
  112  
  113   "BLD",1054 2,"KRN","B ",.403,.40 3)
  114  
  115   "BLD",1054 2,"KRN","B ",.5,.5)
  116  
  117   "BLD",1054 2,"KRN","B ",.84,.84)
  118  
  119   "BLD",1054 2,"KRN","B ",3.6,3.6)
  120  
  121   "BLD",1054 2,"KRN","B ",3.8,3.8)
  122  
  123   "BLD",1054 2,"KRN","B ",9.2,9.2)
  124  
  125   "BLD",1054 2,"KRN","B ",9.8,9.8)
  126  
  127   "BLD",1054 2,"KRN","B ",19,19)
  128  
  129   "BLD",1054 2,"KRN","B ",19.1,19. 1)
  130  
  131   "BLD",1054 2,"KRN","B ",101,101)
  132  
  133   "BLD",1054 2,"KRN","B ",409.61,4 09.61)
  134  
  135   "BLD",1054 2,"KRN","B ",771,771)
  136  
  137   "BLD",1054 2,"KRN","B ",779.2,77 9.2)
  138  
  139   "BLD",1054 2,"KRN","B ",870,870)
  140  
  141   "BLD",1054 2,"KRN","B ",8989.51, 8989.51)
  142  
  143   "BLD",1054 2,"KRN","B ",8989.52, 8989.52)
  144  
  145   "BLD",1054 2,"KRN","B ",8994,899 4)
  146  
  147   "BLD",1054 2,"QDEF")
  148   ^^^^NO^^^^ NO^^NO
  149   "BLD",1054 2,"QUES",0 )
  150   ^9.62^^
  151   "BLD",1054 2,"REQB",0 )
  152   ^9.611^2^2
  153   "BLD",1054 2,"REQB",1 ,0)
  154   PSO*7.0*46 7^2
  155   "BLD",1054 2,"REQB",2 ,0)
  156   PSO*7.0*50 4^2
  157   "BLD",1054 2,"REQB"," B","PSO*7. 0*467",1)
  158  
  159   "BLD",1054 2,"REQB"," B","PSO*7. 0*504",2)
  160  
  161   "MBREQ")
  162   0
  163   "PKG",170, -1)
  164   1^1
  165   "PKG",170, 0)
  166   OUTPATIENT  PHARMACY^ PSO^OUTPAT IENT LABEL S, PROFILE , INVENTOR Y, PRESCRI PTIONS
  167   "PKG",170, 20,0)
  168   ^9.402P^^
  169   "PKG",170, 22,0)
  170   ^9.49I^1^1
  171   "PKG",170, 22,1,0)
  172   7.0^297121 6^2981113^ 1
  173   "PKG",170, 22,1,"PAH" ,1,0)
  174   524^318060 5
  175   "PKG",170, 22,1,"PAH" ,1,1,0)
  176   ^^14^14^31 80605
  177   "PKG",170, 22,1,"PAH" ,1,1,1,0)
  178   Patch PSO* 7.0*524 wi ll enhance  Outpatien t Prescrip tion Proce ssing by
  179   "PKG",170, 22,1,"PAH" ,1,1,2,0)
  180   adding an  alert to P harmacists  and Pharm acy techni cians duri ng Finishi ng
  181   "PKG",170, 22,1,"PAH" ,1,1,3,0)
  182   an outpati ent order  that invol ves a Haza rdous to H andle and/ or a Hazar dous
  183   "PKG",170, 22,1,"PAH" ,1,1,4,0)
  184   to Dispose  drug.
  185   "PKG",170, 22,1,"PAH" ,1,1,5,0)
  186    
  187   "PKG",170, 22,1,"PAH" ,1,1,6,0)
  188                                     * NOTICE  *
  189   "PKG",170, 22,1,"PAH" ,1,1,7,0)
  190      This CA S-RXSU2 pr oject is a n enhancem ent that i ncludes 5  patches th at
  191   "PKG",170, 22,1,"PAH" ,1,1,8,0)
  192      should  be install ed togethe r:
  193   "PKG",170, 22,1,"PAH" ,1,1,9,0)
  194      
  195   "PKG",170, 22,1,"PAH" ,1,1,10,0)
  196                              1. PS S*1*226
  197   "PKG",170, 22,1,"PAH" ,1,1,11,0)
  198                              2. PS O*7*524
  199   "PKG",170, 22,1,"PAH" ,1,1,12,0)
  200                              3. PS J*5*364
  201   "PKG",170, 22,1,"PAH" ,1,1,13,0)
  202                              4. PS B*3*106
  203   "PKG",170, 22,1,"PAH" ,1,1,14,0)
  204                              5. PS B*3*108     
  205   "QUES","XP F1",0)
  206   Y
  207   "QUES","XP F1","??")
  208   ^D REP^XPD H
  209   "QUES","XP F1","A")
  210   Shall I wr ite over y our |FLAG|  File
  211   "QUES","XP F1","B")
  212   YES
  213   "QUES","XP F1","M")
  214   D XPF1^XPD IQ
  215   "QUES","XP F2",0)
  216   Y
  217   "QUES","XP F2","??")
  218   ^D DTA^XPD H
  219   "QUES","XP F2","A")
  220   Want my da ta |FLAG|  yours
  221   "QUES","XP F2","B")
  222   YES
  223   "QUES","XP F2","M")
  224   D XPF2^XPD IQ
  225   "QUES","XP I1",0)
  226   YO
  227   "QUES","XP I1","??")
  228   ^D INHIBIT ^XPDH
  229   "QUES","XP I1","A")
  230   Want KIDS  to INHIBIT  LOGONs du ring the i nstall
  231   "QUES","XP I1","B")
  232   NO
  233   "QUES","XP I1","M")
  234   D XPI1^XPD IQ
  235   "QUES","XP M1",0)
  236   PO^VA(200, :EM
  237   "QUES","XP M1","??")
  238   ^D MG^XPDH
  239   "QUES","XP M1","A")
  240   Enter the  Coordinato r for Mail  Group '|F LAG|'
  241   "QUES","XP M1","B")
  242  
  243   "QUES","XP M1","M")
  244   D XPM1^XPD IQ
  245   "QUES","XP O1",0)
  246   Y
  247   "QUES","XP O1","??")
  248   ^D MENU^XP DH
  249   "QUES","XP O1","A")
  250   Want KIDS  to Rebuild  Menu Tree s Upon Com pletion of  Install
  251   "QUES","XP O1","B")
  252   NO
  253   "QUES","XP O1","M")
  254   D XPO1^XPD IQ
  255   "QUES","XP Z1",0)
  256   Y
  257   "QUES","XP Z1","??")
  258   ^D OPT^XPD H
  259   "QUES","XP Z1","A")
  260   Want to DI SABLE Sche duled Opti ons, Menu  Options, a nd Protoco ls
  261   "QUES","XP Z1","B")
  262   NO
  263   "QUES","XP Z1","M")
  264   D XPZ1^XPD IQ
  265   "QUES","XP Z2",0)
  266   Y
  267   "QUES","XP Z2","??")
  268   ^D RTN^XPD H
  269   "QUES","XP Z2","A")
  270   Want to MO VE routine s to other  CPUs
  271   "QUES","XP Z2","B")
  272   NO
  273   "QUES","XP Z2","M")
  274   D XPZ2^XPD IQ
  275   "RTN")
  276   5
  277   "RTN","PSO DRG")
  278   0^1^B10402 6958
  279   "RTN","PSO DRG",1,0)
  280   PSODRG ;IH S/DSD/JCM  - ORDER EN TRY DRUG S ELECTION ; 2/16/12 12 :50pm
  281   "RTN","PSO DRG",2,0)
  282    ;;7.0;OUT PATIENT PH ARMACY;**2 0,23,36,53 ,54,46,112 ,139,207,1 48,243,268 ,324,251,3 75,387,398 ,390,427,4 11,458,504 ,524**;DEC  1997;Buil d 12
  283   "RTN","PSO DRG",3,0)
  284    ;Referenc e to ^PSDR UG( suppor ted by DBI A 221
  285   "RTN","PSO DRG",4,0)
  286    ;Referenc e to ^PS(5 0.7 suppor ted by DBI A 2223
  287   "RTN","PSO DRG",5,0)
  288    ;Referenc e to $$PRO MPT^PSSDIN  supported  by DBIA 3 166
  289   "RTN","PSO DRG",6,0)
  290    ;Referenc e to EN^PS SDIN suppo rted by DB IA 3166
  291   "RTN","PSO DRG",7,0)
  292    ;Referenc e to $$GET NDC^PSSNDC UT support ed by DBIA  4707
  293   "RTN","PSO DRG",8,0)
  294    ;Referenc e to ^OROC API contro lled subsc ription su pported by  DBIA 5367
  295   "RTN","PSO DRG",9,0)
  296    ;Referenc e to $$OIT M^ORX8 sup ported by  DBIA 5469
  297   "RTN","PSO DRG",10,0)
  298    ;Referenc e to ^VADP T supporte d by DBIA  10061
  299   "RTN","PSO DRG",11,0)
  300    ;Referenc e to IN^PS SHRQ2 supp orted by D BIA 5369
  301   "RTN","PSO DRG",12,0)
  302    ;Referenc e to ^XTMP ("ORRDI" s upported b y DBIA 544 0
  303   "RTN","PSO DRG",13,0)
  304    ;
  305   "RTN","PSO DRG",14,0)
  306    ;*524 Add  HAZ Handl e & Haz Di spose Aler t pre-orde r checks
  307   "RTN","PSO DRG",15,0)
  308    ;-------- ---------- ---------- ---------- ---------- ----------
  309   "RTN","PSO DRG",16,0)
  310   START ;
  311   "RTN","PSO DRG",17,0)
  312    S (PSONEW ("DFLG"),P SONEW("FIE LD"),PSODR G("QFLG")) =0 K PSORX ("DFLG")
  313   "RTN","PSO DRG",18,0)
  314    D @($S(+$ G(PSOEDIT) =1&('$D(DA )):"SELECT ^PSODRGN", 1:"SELECT" ))
  315   "RTN","PSO DRG",19,0)
  316    G:$G(PSOR XED("DFLG" )) END ; S elect Drug
  317   "RTN","PSO DRG",20,0)
  318    I $G(PSOR X("EDIT")) ,$G(PSOY), $G(PSODRUG ("IEN"))=+ PSOY D  G: $G(PSORXED ("DFLG"))  END
  319   "RTN","PSO DRG",21,0)
  320    . N NDC D  NDC(+$G(P SORXED("IR XN")),0,+P SOY,.NDC)  I $G(NDC)= "^" S PSOR XED("DFLG" )=1 Q
  321   "RTN","PSO DRG",22,0)
  322    . I $G(ND C)'="" S ( PSODRUG("N DC"),PSORX ED("FLD",2 7))=NDC
  323   "RTN","PSO DRG",23,0)
  324    ;
  325   "RTN","PSO DRG",24,0)
  326    I $G(PSOR X("EDIT")) ]"",'PSONE W("FIELD")  D TRADE
  327   "RTN","PSO DRG",25,0)
  328    G:$G(PSON EW("DFLG") )!($G(PSOD RG("QFLG") ))!($G(PSO RXED("DFLG "))) END
  329   "RTN","PSO DRG",26,0)
  330    D SET ; S et various  drug info rmation
  331   "RTN","PSO DRG",27,0)
  332    D NFI ; D isplay dis pense drug /orderable  item text
  333   "RTN","PSO DRG",28,0)
  334    D:'$G(PSO EDIT) POST  I $G(PSOR X("DFLG"))  S PSONEW( "DFLG")=1  K:'$G(PSOR X("EDIT"))  PSORX("DF LG") ; Do  any post s election a ction
  335   "RTN","PSO DRG",29,0)
  336   END ;D EOJ
  337   "RTN","PSO DRG",30,0)
  338    Q
  339   "RTN","PSO DRG",31,0)
  340    ;-------- ---------- ---------- ---------- ---------- ---------- --
  341   "RTN","PSO DRG",32,0)
  342    ;
  343   "RTN","PSO DRG",33,0)
  344   SELECT ;
  345   "RTN","PSO DRG",34,0)
  346    K:'$G(PSO RXED) CLOZ PAT
  347   "RTN","PSO DRG",35,0)
  348    K IT,DIC, X,Y,PSODRU G("TRADE N AME"),PSOD RUG("NDC") ,PSODRUG(" DAW"),PSOD RUG("BAD")  S:$G(POER R)&($P($G( OR0),"^",9 )) Y=$P(^P SDRUG($P(O R0,"^",9), 0),"^")
  349   "RTN","PSO DRG",36,0)
  350    I $G(PSOD RUG("IEN") )]"" S Y=P SODRUG("NA ME"),PSONE W("OLD VAL ")=PSODRUG ("IEN")
  351   "RTN","PSO DRG",37,0)
  352    W !,"DRUG : "_$S($G( Y)]"":Y_"/ / ",1:"")  R X:$S($D( DTIME):DTI ME,1:300)  I '$T S DT OUT=1
  353   "RTN","PSO DRG",38,0)
  354    I X="",$G (Y)]"" S:Y  X=Y S:'X  X=$G(PSODR UG("IEN"))  S:X X="`" _X
  355   "RTN","PSO DRG",39,0)
  356    G:X="" SE LECT
  357   "RTN","PSO DRG",40,0)
  358    I X?1."?"  W !!,"Ans wer with D RUG NUMBER , or GENER IC NAME, o r VA PRODU CT NAME, o r",!,"NATI ONAL DRUG  CLASS, or  SYNONYM" G  SELECT
  359   "RTN","PSO DRG",41,0)
  360    I $G(PSOR XED),X["^"  S PSORXED ("DFLG")=1  G SELECTX
  361   "RTN","PSO DRG",42,0)
  362    I X="^"!( X["^^")!($ D(DTOUT))  S PSONEW(" DFLG")=1 G  SELECTX
  363   "RTN","PSO DRG",43,0)
  364    I '$G(POE RR),X[U,$L (X)>1 S PS ODIR("FLD" )=PSONEW(" FLD") D JU MP^PSODIR1  S:$G(PSOD IR("FIELD" )) PSONEW( "FIELD")=P SODIR("FIE LD") K PSO DIR S PSOD RG("QFLG") =1 G SELEC TX
  365   "RTN","PSO DRG",44,0)
  366    S DIC=50, DIC(0)="EM QZVT",DIC( "T")="",D= "B^C^VAPN^ VAC"
  367   "RTN","PSO DRG",45,0)
  368    S DIC("S" )="I $S('$ D(^PSDRUG( +Y,""I"")) :1,'^(""I" "):1,DT'>^ (""I""):1, 1:0),$S($P ($G(^PSDRU G(+Y,2))," "^"",3)'[" "O"":0,1:1 ),$D(^PSDR UG(""ASP"" ,+$G(^(2)) ,+Y))"
  369   "RTN","PSO DRG",46,0)
  370    D MIX^DIC 1 K DIC,D
  371   "RTN","PSO DRG",47,0)
  372    I $D(DTOU T) S PSONE W("DFLG")= 1 G SELECT X
  373   "RTN","PSO DRG",48,0)
  374    I $D(DUOU T) K DUOUT  G SELECT
  375   "RTN","PSO DRG",49,0)
  376    I Y<0 G S ELECT
  377   "RTN","PSO DRG",50,0)
  378    S:$G(PSON EW("OLD VA L"))=+Y&(' $G(PSOEDIT )) PSODRG( "QFLG")=1
  379   "RTN","PSO DRG",51,0)
  380    K PSOY S  PSOY=Y,PSO Y(0)=Y(0)
  381   "RTN","PSO DRG",52,0)
  382    I $P(PSOY (0),"^")=" OTHER DRUG "!($P(PSOY (0),"^")=" OUTSIDE DR UG") D TRA DE
  383   "RTN","PSO DRG",53,0)
  384   SELECTX K  X,Y,DTOUT, DUOUT,PSON EW("OLD VA L")
  385   "RTN","PSO DRG",54,0)
  386    Q
  387   "RTN","PSO DRG",55,0)
  388    ;
  389   "RTN","PSO DRG",56,0)
  390   NDC(RX,RFL ,DRG,NDC)  ; Editing  NDC for Re leased Rx' s or for U nresolved  ECME Rejec ts
  391   "RTN","PSO DRG",57,0)
  392    S NDC=$S( $G(NDC)'=" ":$G(NDC), 1:$$GETNDC ^PSONDCUT( RX,.RFL))
  393   "RTN","PSO DRG",58,0)
  394    ; Check i f we shoul d edit the  NDC
  395   "RTN","PSO DRG",59,0)
  396    ; Needs t o be relea sed or hav e unresolv ed billabl e rejects  (PSO*7*427 )
  397   "RTN","PSO DRG",60,0)
  398    ;
  399   "RTN","PSO DRG",61,0)
  400    N PSOCONT  S PSOCONT =0                           ; c ontinue fl ag
  401   "RTN","PSO DRG",62,0)
  402    D  Q:'PSO CONT                                    ; g et out if  NDC edit n ot allowed
  403   "RTN","PSO DRG",63,0)
  404    . I $$RXR LDT^PSOBPS UT(RX,RFL)  S PSOCONT =1 Q   ; R eleased -  continue a nd allow e dit
  405   "RTN","PSO DRG",64,0)
  406    . I $$FIN D^PSOREJUT (RX,RFL),$ $STATUS^PS OBPSUT(RX, RFL)'="" S  PSOCONT=1  Q    ; un released w /unresolve d billable  rejection s
  407   "RTN","PSO DRG",65,0)
  408    . Q
  409   "RTN","PSO DRG",66,0)
  410    ;
  411   "RTN","PSO DRG",67,0)
  412    S NDC=$S( $G(NDC)'=" ":$G(NDC), 1:$$GETNDC ^PSONDCUT( RX,.RFL))
  413   "RTN","PSO DRG",68,0)
  414    D NDCEDT^ PSONDCUT(R X,.RFL,$G( DRG),$G(PS OSITE),.ND C)
  415   "RTN","PSO DRG",69,0)
  416    Q
  417   "RTN","PSO DRG",70,0)
  418    ;
  419   "RTN","PSO DRG",71,0)
  420   TRADE ;
  421   "RTN","PSO DRG",72,0)
  422    K DIR,DIC ,DA,X,Y
  423   "RTN","PSO DRG",73,0)
  424    S DIR(0)= "52,6.5" S :$G(PSOTRN )]"" DIR(" B")=$G(PSO TRN) D ^DI R K DIR,DI C
  425   "RTN","PSO DRG",74,0)
  426    I X="@" S  Y=X K DIR UT
  427   "RTN","PSO DRG",75,0)
  428    I $D(DIRU T) S:$D(DU OUT)!$D(DT OUT)&('$D( PSORX("EDI T"))) PSON EW("DFLG") =1 G TRADE X
  429   "RTN","PSO DRG",76,0)
  430    S PSODRUG ("TRADE NA ME")=Y
  431   "RTN","PSO DRG",77,0)
  432   TRADEX I $ G(PSORXED( "DFLG")),$ D(DIRUT) S  PSORXED(" DFLG")=1
  433   "RTN","PSO DRG",78,0)
  434    K DIRUT,D TOUT,DUOUT ,X,Y,DA,DR ,DIE
  435   "RTN","PSO DRG",79,0)
  436    Q
  437   "RTN","PSO DRG",80,0)
  438   SET ;
  439   "RTN","PSO DRG",81,0)
  440    N PSOHZ S  PSOHZ=0     ;init ha z alert sh own to use r=no *524 
  441   "RTN","PSO DRG",82,0)
  442    N STAT S  PSODRUG("I EN")=+PSOY ,PSODRUG(" VA CLASS") =$P(PSOY(0 ),"^",2)
  443   "RTN","PSO DRG",83,0)
  444    S PSODRUG ("NAME")=$ P(PSOY(0), "^")
  445   "RTN","PSO DRG",84,0)
  446    S:+$G(^PS DRUG(+PSOY ,2)) PSODR UG("OI")=+ $G(^(2)),P SODRUG("OI N")=$P(^PS (50.7,+$G( ^(2)),0)," ^")
  447   "RTN","PSO DRG",85,0)
  448    S PSODRUG ("NDF")=$S ($G(^PSDRU G(+PSOY,"N D"))]"":+^ ("ND")_"A" _$P(^("ND" ),"^",3),1 :0)
  449   "RTN","PSO DRG",86,0)
  450    S PSODRUG ("MAXDOSE" )=$P(PSOY( 0),"^",4), PSODRUG("D EA")=$P(PS OY(0),"^", 3)
  451   "RTN","PSO DRG",87,0)
  452    S PSODRUG ("CLN")=$S ($D(^PSDRU G(+PSOY,"N D")):+$P(^ ("ND"),"^" ,6),1:0)
  453   "RTN","PSO DRG",88,0)
  454    S PSODRUG ("SIG")=$P (PSOY(0)," ^",5)
  455   "RTN","PSO DRG",89,0)
  456    I $G(PSOD RUG("NDC") )="" S PSO DRUG("NDC" )=$$GETNDC ^PSSNDCUT( +PSOY,$G(P SOSITE))
  457   "RTN","PSO DRG",90,0)
  458    S PSODRUG ("DAW")=+$ $GET1^DIQ( 50,+PSOY,8 1)
  459   "RTN","PSO DRG",91,0)
  460    S PSODRUG ("STKLVL") =$G(^PSDRU G(+PSOY,66 0.1))
  461   "RTN","PSO DRG",92,0)
  462    G:$G(^PSD RUG(+PSOY, 660))']""  SETX
  463   "RTN","PSO DRG",93,0)
  464    S PSOX1=$ G(^PSDRUG( +PSOY,660) )
  465   "RTN","PSO DRG",94,0)
  466    S PSODRUG ("COST")=$ P($G(PSOX1 ),"^",6)
  467   "RTN","PSO DRG",95,0)
  468    S PSODRUG ("UNIT")=$ P($G(PSOX1 ),"^",8)
  469   "RTN","PSO DRG",96,0)
  470    S PSODRUG ("EXPIRATI ON DATE")= $P($G(PSOX 1),"^",9)
  471   "RTN","PSO DRG",97,0)
  472   SETX K PSO X1,PSOY
  473   "RTN","PSO DRG",98,0)
  474    Q
  475   "RTN","PSO DRG",99,0)
  476   NFI ;displ ay restric tion/guide lines
  477   "RTN","PSO DRG",100,0 )
  478    D EN^PSSD IN(PSODRUG ("OI"),PSO DRUG("IEN" )) S NFI=$ $PROMPT^PS SDIN
  479   "RTN","PSO DRG",101,0 )
  480    I NFI]"", "ODY"[NFI  D TD^PSONF I
  481   "RTN","PSO DRG",102,0 )
  482    K NFI Q
  483   "RTN","PSO DRG",103,0 )
  484   POST ;orde r checks
  485   "RTN","PSO DRG",104,0 )
  486    ;add Haza rdous to H andle/Disp ose warnin g messages                                                   *524
  487   "RTN","PSO DRG",105,0 )
  488    N HAZ,HAZ H,HAZD,HTX T,LL S HAZ =$$HAZ^PSS UTIL(PSODR UG("IEN")) ,HAZH=$P(H AZ,U),HAZD =$P(HAZ,U, 2)
  489   "RTN","PSO DRG",106,0 )
  490    I ('$G(PS OHZ)!(PSOD RUG("IEN") '=$G(PSOLS TDR))),(HA ZH!HAZD) D
  491   "RTN","PSO DRG",107,0 )
  492    . S PSOHZ =1,PSOLSTD R=PSODRUG( "IEN")
  493   "RTN","PSO DRG",108,0 )
  494    . D HAZWA RNG^PSSUTI L(PSODRUG( "IEN"),"O" ,HAZH,HAZD ,.HTXT)
  495   "RTN","PSO DRG",109,0 )
  496    . S $P(LL ,"-",80)=" -"
  497   "RTN","PSO DRG",110,0 )
  498    . W #,$C( 7),LL,!
  499   "RTN","PSO DRG",111,0 )
  500    . W $J("* **** WARNI NG *****", 47)
  501   "RTN","PSO DRG",112,0 )
  502    . D WRAPT EXT^PSOQUT IL(HTXT,80 ,0) W !
  503   "RTN","PSO DRG",113,0 )
  504    . W LL,!
  505   "RTN","PSO DRG",114,0 )
  506    . K DIR S  DIR(0)="E ",DIR("?") ="Press Re turn to co ntinue",DI R("A")="Pr ess Return  to contin ue" D ^DIR
  507   "RTN","PSO DRG",115,0 )
  508    N LIST S  LIST="PSOP EPS"
  509   "RTN","PSO DRG",116,0 )
  510    K PSODOSD ,^TMP("PSO RXDC",$J), ^TMP($J,LI ST),^TMP(" PSODAOC",$ J)
  511   "RTN","PSO DRG",117,0 )
  512    K ZDGDG,Z THER,IT,PS ODLQT,PSOD OSD
  513   "RTN","PSO DRG",118,0 )
  514    I $D(^XTM P("ORRDI", "OUTAGE IN FO","DOWN" )) S ^TMP( "PSODAOC", $J,"NORDI" ,1,0)="Rem ote data n ot availab le - Only  local orde r checks p rocessed."
  515   "RTN","PSO DRG",119,0 )
  516    S ^TMP($J ,LIST,"IN" ,"PING")=" " D IN^PSS HRQ2(LIST)
  517   "RTN","PSO DRG",120,0 )
  518    K DIR I $ P(^TMP($J, LIST,"OUT" ,0),"^")=- 1 D
  519   "RTN","PSO DRG",121,0 )
  520    .D DATACK ^PSODDPRE
  521   "RTN","PSO DRG",122,0 )
  522    .S ^TMP(" PSODAOC",$ J,"NOSYS", 1,0)="No E nhanced Or der Checks  can be pe rformed. R eason(s):  "_$P($G(^T MP($J,LIST ,"OUT",0)) ,"^",2)
  523   "RTN","PSO DRG",123,0 )
  524    K ^TMP($J ,LIST,"IN" ),^TMP($J, LIST,"OUT" ,"EXCEPTIO NS")
  525   "RTN","PSO DRG",124,0 )
  526    G:$G(PSOR X("DFLG")) !($G(PSORX ED("DFLG") )) POSTX
  527   "RTN","PSO DRG",125,0 )
  528    K PSORX(" INTERVENE" ),PSOQUIT  N STAT,SIG ,PTR,NDF,V AP S PSORX ("DFLG")=0
  529   "RTN","PSO DRG",126,0 )
  530    W !! D HD ^PSODDPR2( ):(($Y+5)' >IOSL)
  531   "RTN","PSO DRG",127,0 )
  532    D ^PSOBUI LD
  533   "RTN","PSO DRG",128,0 )
  534    D @$S($G( COPY):"^PS OCPPRE",1: "^PSODDPRE ") ; Dupli cate drug  check
  535   "RTN","PSO DRG",129,0 )
  536    G:$G(PSOR X("DFLG"))  POSTX
  537   "RTN","PSO DRG",130,0 )
  538    D HD^PSOD DPR2():(($ Y+5)'>IOSL )
  539   "RTN","PSO DRG",131,0 )
  540    I $P($G(^ PSDRUG(PSO DRUG("IEN" ),"CLOZ1") ),"^")="PS OCLO1" W ! ,"Now doin g Clozapin e Order ch ecks.  Ple ase wait.. .",! D CLO Z
  541   "RTN","PSO DRG",132,0 )
  542    G:PSORX(" DFLG") POS TX
  543   "RTN","PSO DRG",133,0 )
  544    D HD^PSOD DPR2():(($ Y+5)'>IOSL )
  545   "RTN","PSO DRG",134,0 )
  546    W !,"Now  doing alle rgy checks .  Please  wait...",!  H 1
  547   "RTN","PSO DRG",135,0 )
  548    S PSONOAL ="" D ALLE RGY^PSOORU T2 D:PSONO AL'="" NOA LRGY K PSO NOAL
  549   "RTN","PSO DRG",136,0 )
  550    D HD^PSOD DPR2():(($ Y+5)'>IOSL )
  551   "RTN","PSO DRG",137,0 )
  552    I '$G(PSO DGCKX) D ^ PSODGAL1 K  PSORX("IN TERVENE")
  553   "RTN","PSO DRG",138,0 )
  554    G:PSORX(" DFLG")!$G( PSOQUIT) P OSTX
  555   "RTN","PSO DRG",139,0 )
  556    ;This is  the allerg y check fo r profile  drugs CK a ction
  557   "RTN","PSO DRG",140,0 )
  558    I $D(PSOD GCK),$D(PS OSD) D PRF LP^PSOUTL
  559   "RTN","PSO DRG",141,0 )
  560    G:$G(PSOR X("DFLG"))  POSTX ;ps o*7*412
  561   "RTN","PSO DRG",142,0 )
  562    G:$G(PSOS PRNW)&($G( PSORENW("D FLG"))) PO STX ;speed  renew
  563   "RTN","PSO DRG",143,0 )
  564    ;aminogly coside
  565   "RTN","PSO DRG",144,0 )
  566    N AOC,CRO CPFLG S CR OCPFLG=0
  567   "RTN","PSO DRG",145,0 )
  568    D HD^PSOD DPR2():(($ Y+5)'>IOSL )
  569   "RTN","PSO DRG",146,0 )
  570    S AOC=$$A OC^OROCAPI (PSODFN,$P (PSODRUG(" NDF"),"A", 2)) I $P(A OC,"^",4)] "" D
  571   "RTN","PSO DRG",147,0 )
  572    .S CROCPF LG=1
  573   "RTN","PSO DRG",148,0 )
  574    .W !!,"** *Aminoglyc oside Orde red***",!!
  575   "RTN","PSO DRG",149,0 )
  576    .K ^UTILI TY($J,"W")  S DIWL=1, DIWR=78,DI WF="" S X= $P(AOC,"^" ,4) D ^DIW P
  577   "RTN","PSO DRG",150,0 )
  578    .W ! F ZX =0:0 S ZX= $O(^UTILIT Y($J,"W",1 ,ZX)) Q:'Z X  W ?2,^U TILITY($J, "W",1,ZX,0 ),! D HD^P SODDPR2(): (($Y+5)'>I OSL)
  579   "RTN","PSO DRG",151,0 )
  580    .K ^UTILI TY($J,"W")
  581   "RTN","PSO DRG",152,0 )
  582    .S ^TMP(" PSODAOC",$ J,"CPRS",$ P(AOC,"^", 2),0)=PSOD RUG("IEN") _"^"_$P(AO C,"^",4)
  583   "RTN","PSO DRG",153,0 )
  584    .W !
  585   "RTN","PSO DRG",154,0 )
  586    D HD^PSOD DPR2():(($ Y+5)'>IOSL )
  587   "RTN","PSO DRG",155,0 )
  588    ;dangerou s meds for  pat >64
  589   "RTN","PSO DRG",156,0 )
  590    I $G(PSOD RUG("OI"))  D
  591   "RTN","PSO DRG",157,0 )
  592    .N OI,OIR  S OI=$$OI TM^ORX8(PS ODRUG("OI" ),"99PSP")  Q:'OI
  593   "RTN","PSO DRG",158,0 )
  594    .S OIR=$$ DOC^OROCAP I(PSODFN,O I) I $P(OI R,"^",4)]" " D
  595   "RTN","PSO DRG",159,0 )
  596    ..S CROCP FLG=1
  597   "RTN","PSO DRG",160,0 )
  598    ..D HD^PS ODDPR2():( ($Y+5)'>IO SL) W !!," ***Dangero us Meds fo r Patient  >64***",!!  S DFN=PSO DFN D DEM^ VADPT
  599   "RTN","PSO DRG",161,0 )
  600    ..K ^UTIL ITY($J,"W" ) S DIWL=1 ,DIWR=78,D IWF="" S X =$P(OIR,"^ ",4) D ^DI WP
  601   "RTN","PSO DRG",162,0 )
  602    ..F ZX=0: 0 S ZX=$O( ^UTILITY($ J,"W",1,ZX )) Q:'ZX   W ?2,^UTIL ITY($J,"W" ,1,ZX,0),!  D HD^PSOD DPR2():(($ Y+5)'>IOSL )
  603   "RTN","PSO DRG",163,0 )
  604    ..K ^UTIL ITY($J,"W" )
  605   "RTN","PSO DRG",164,0 )
  606    ..S ^TMP( "PSODAOC", $J,"CPRS", $P(OIR,"^" ,2),0)=PSO DRUG("IEN" )_"^"_$P(O IR,"^",4)
  607   "RTN","PSO DRG",165,0 )
  608    ..W !
  609   "RTN","PSO DRG",166,0 )
  610    D HD^PSOD DPR2():(($ Y+5)'>IOSL )
  611   "RTN","PSO DRG",167,0 )
  612    ;metformi n lab resu lts
  613   "RTN","PSO DRG",168,0 )
  614    N GOC S G OC=$$GOC^O ROCAPI(PSO DFN,PSODRU G("NAME"))  I $P(GOC, "^",4)]""  D
  615   "RTN","PSO DRG",169,0 )
  616    .S CROCPF LG=1
  617   "RTN","PSO DRG",170,0 )
  618    .W !!,"** *Metformin  Lab Resul ts***",!!
  619   "RTN","PSO DRG",171,0 )
  620    .K ^UTILI TY($J,"W")  S DIWL=1, DIWR=78,DI WF="" S X= $P(GOC,"^" ,4) D ^DIW P
  621   "RTN","PSO DRG",172,0 )
  622    .F ZX=0:0  S ZX=$O(^ UTILITY($J ,"W",1,ZX) ) Q:'ZX  W  ?2,^UTILI TY($J,"W", 1,ZX,0),!  D HD^PSODD PR2():(($Y +5)'>IOSL)
  623   "RTN","PSO DRG",173,0 )
  624    .K ^UTILI TY($J,"W")
  625   "RTN","PSO DRG",174,0 )
  626    .S ^TMP(" PSODAOC",$ J,"CPRS",$ P(GOC,"^", 2),0)=PSOD RUG("IEN") _"^"_$P(GO C,"^",4)
  627   "RTN","PSO DRG",175,0 )
  628    .W !
  629   "RTN","PSO DRG",176,0 )
  630    D HD^PSOD DPR2():(($ Y+5)'>IOSL )
  631   "RTN","PSO DRG",177,0 )
  632    ;clinical  reminder  oc
  633   "RTN","PSO DRG",178,0 )
  634    D:'$G(PSO NCROC) CK^ PSOCROC K  CROCPFLG I  $G(PSORX( "DFLG")) Q
  635   "RTN","PSO DRG",179,0 )
  636    K DIWF,DI WL,DIWR,ZX ,DFN,CROCP FLG
  637   "RTN","PSO DRG",180,0 )
  638    I $G(PSOD RUG("DEA") )["S"!($E( $G(PSODRUG ("VA CLASS ")),1,2)=" XA"),'$G(P SODGCK) D   G POSTX ; stops if d rug is sup ply
  639   "RTN","PSO DRG",181,0 )
  640    .W !,"Now  Processin g Enhanced  Order Che cks!  Plea se wait... ",! H 1
  641   "RTN","PSO DRG",182,0 )
  642    ;enhanced  OC
  643   "RTN","PSO DRG",183,0 )
  644    D HD^PSOD DPR2():(($ Y+5)'>IOSL )
  645   "RTN","PSO DRG",184,0 )
  646    W ! D @$S ($G(COPY): "OBX^PSOCP PRE",1:"OB X^PSODDPRE ") ; Set P SORX("DFLG ")=1 if pr ocess to s top new en hanced ord er checks
  647   "RTN","PSO DRG",185,0 )
  648   POSTX ;
  649   "RTN","PSO DRG",186,0 )
  650    K IT,^TMP ($J,"DI"), PSORX("INT ERVENE"),D A,^TMP($J, "PSODRDI") ,ZDGDG,ZTH ER,^TMP($J ,"DI"_PSOD FN),PSZZQU IT
  651   "RTN","PSO DRG",187,0 )
  652    I '$G(PSO RXED),'$G( PSOREINS)  K PSOQUIT
  653   "RTN","PSO DRG",188,0 )
  654    Q
  655   "RTN","PSO DRG",189,0 )
  656    ;
  657   "RTN","PSO DRG",190,0 )
  658   EOJ ;
  659   "RTN","PSO DRG",191,0 )
  660    K PSODRG
  661   "RTN","PSO DRG",192,0 )
  662    Q
  663   "RTN","PSO DRG",193,0 )
  664   WAIT ;
  665   "RTN","PSO DRG",194,0 )
  666    K DIR S D IR(0)="E", DIR("?")=" Press Retu rn to cont inue",DIR( "A")="Pres s Return t o continue ..." W !
  667   "RTN","PSO DRG",195,0 )
  668    D ^DIR K  DIRUT,DUOU T,DIR,X,Y
  669   "RTN","PSO DRG",196,0 )
  670    Q
  671   "RTN","PSO DRG",197,0 )
  672    ;
  673   "RTN","PSO DRG",198,0 )
  674   CLOZ ;
  675   "RTN","PSO DRG",199,0 )
  676    S ANQRTN= $P(^PSDRUG (PSODRUG(" IEN"),"CLO Z1"),"^"), ANQX=0
  677   "RTN","PSO DRG",200,0 )
  678    S P(5)=PS ODRUG("IEN "),DFN=PSO DFN,X=ANQR TN
  679   "RTN","PSO DRG",201,0 )
  680    X ^%ZOSF( "TEST") I   D @("^"_A NQRTN) S:$ G(ANQX) PS ORX("DFLG" )=1
  681   "RTN","PSO DRG",202,0 )
  682    K P(5),AN QRTN,ANQX, X,DFN
  683   "RTN","PSO DRG",203,0 )
  684    Q
  685   "RTN","PSO DRG",204,0 )
  686    ;
  687   "RTN","PSO DRG",205,0 )
  688   EN(DRG) ;r eturns lab  test iden tified for  clozapine  order che cking
  689   "RTN","PSO DRG",206,0 )
  690    K LAB I $ P($G(^PSDR UG(DRG,"CL OZ1")),"^" )'="PSOCLO 1" S LAB(" NOT")=0 Q
  691   "RTN","PSO DRG",207,0 )
  692    I $P($G(^ PSDRUG(DRG ,"CLOZ1")) ,"^")="PSO CLO1" D
  693   "RTN","PSO DRG",208,0 )
  694    .S (CNT,I )=0 F  S I =$O(^PSDRU G(DRG,"CLO Z2",I)) Q: 'I  S CNT= $G(CNT)+1
  695   "RTN","PSO DRG",209,0 )
  696    .I CNT'=2  S LAB("BA D TEST")=0  K CNT Q
  697   "RTN","PSO DRG",210,0 )
  698    .K CNT F  I=0:0 S I= $O(^PSDRUG (DRG,"CLOZ 2",I)) Q:' I  D
  699   "RTN","PSO DRG",211,0 )
  700    ..S LABT= $S($P(^PSD RUG(DRG,"C LOZ2",I,0) ,"^",4)=1: "WBC",1:"A NC"),LAB(L ABT)=$P(^P SDRUG(DRG, "CLOZ2",I, 0),"^")_"^ "_$P(^(0), "^",3)_"^" _$P(^(0)," ^",4)
  701   "RTN","PSO DRG",212,0 )
  702    K LABT,I
  703   "RTN","PSO DRG",213,0 )
  704    Q
  705   "RTN","PSO DRG",214,0 )
  706   NOALRGY ;
  707   "RTN","PSO DRG",215,0 )
  708    D HD^PSOD DPR2():(($ Y+5)'>IOSL )
  709   "RTN","PSO DRG",216,0 )
  710    N DIR S D IR(0)="SA^ 1:YES;0:NO "
  711   "RTN","PSO DRG",217,0 )
  712    I $D(^TMP ($J,"PSOIN TERVENE",+ PSODFN)) D   Q
  713   "RTN","PSO DRG",218,0 )
  714    .S DIR("A ")="No All ergy Asses sment - Do  you want  to duplica te Interve ntion?: ", DIR("B")=" Yes"
  715   "RTN","PSO DRG",219,0 )
  716    .D ^DIR
  717   "RTN","PSO DRG",220,0 )
  718    .I 'Y D   Q
  719   "RTN","PSO DRG",221,0 )
  720    ..I Y=0 D  ^PSORXI Q
  721   "RTN","PSO DRG",222,0 )
  722    ..S PSORX ("DFLG")=1
  723   "RTN","PSO DRG",223,0 )
  724    .D DUPINV ^PSORXI
  725   "RTN","PSO DRG",224,0 )
  726    W $C(7),! ,"There is  no allerg y assessme nt on file  for this  patient."
  727   "RTN","PSO DRG",225,0 )
  728    W !,"You  will be pr ompted to  intervene  if you con tinue with  this pres cription"
  729   "RTN","PSO DRG",226,0 )
  730    I $D(PSOD GCK) W ! K  DIR S DIR (0)="E",DI R("A")="Pr ess Return  to Contin ue..." D ^ DIR K DIR
  731   "RTN","PSO DRG",227,0 )
  732    Q:$D(PSOD GCK)
  733   "RTN","PSO DRG",228,0 )
  734    N DUOUT,D TOUT,RXIEN ,RXSTA                 ;*398
  735   "RTN","PSO DRG",229,0 )
  736    S DIR("A" )="Do you  want to Co ntinue?: " ,DIR("B")= "N" D ^DIR
  737   "RTN","PSO DRG",230,0 )
  738    I 'Y!($D( DUOUT))!($ D(DTOUT))  D  Q        ;*398 - E xit/Timeou t
  739   "RTN","PSO DRG",231,0 )
  740    .I $D(PSO NV) S PSZZ QUIT=1 Q
  741   "RTN","PSO DRG",232,0 )
  742    .S PSORX( "DFLG")=1
  743   "RTN","PSO DRG",233,0 )
  744    .I '$O(PS CAN(0)) Q                         ;*398 - A rray has R x IEN
  745   "RTN","PSO DRG",234,0 )
  746    .I $G(REA )'="R" Q                          ;*398 - R einstate o nly
  747   "RTN","PSO DRG",235,0 )
  748    .S RXIEN= +$G(PSCAN( RX)) I 'RX IEN Q       ;*398 - G et Rx IEN
  749   "RTN","PSO DRG",236,0 )
  750    .S RXSTA= $$GET1^DIQ (52,RXIEN, 100,"I")    ;*398 - G et status
  751   "RTN","PSO DRG",237,0 )
  752    .I RXSTA= 12 Q                              ;*398 - C orrect sta tus
  753   "RTN","PSO DRG",238,0 )
  754    .S DIE="^ PSRX(",DA= RXIEN,DR=" 100///12"   ;*398 - D iscontinue d
  755   "RTN","PSO DRG",239,0 )
  756    .D ^DIE                                     ;*398 - U pdate Rx f ile
  757   "RTN","PSO DRG",240,0 )
  758    I $D(PSON V) S PSORX ("INTERVEN E")=0 D EN 1^PSORXI(P SONV) Q
  759   "RTN","PSO DRG",241,0 )
  760    D ^PSORXI
  761   "RTN","PSO DRG",242,0 )
  762    Q
  763   "RTN","PSO HLDS1")
  764   0^2^B49887 900
  765   "RTN","PSO HLDS1",1,0 )
  766   PSOHLDS1 ; BIR/LC,PWC -Build HL7  Segments  for Automa ted Interf ace ; 2/5/ 10 10:01am
  767   "RTN","PSO HLDS1",2,0 )
  768    ;;7.0;OUT PATIENT PH ARMACY;**1 56,232,255 ,200,305,3 36,351,434 ,524**;DEC  1997;Buil d 12
  769   "RTN","PSO HLDS1",3,0 )
  770    ;HLFNC        supp.  by DBIA 10 106
  771   "RTN","PSO HLDS1",4,0 )
  772    ;PSNAPIS      supp.  by DBIA 25 31
  773   "RTN","PSO HLDS1",5,0 )
  774    ;VASITE       supp.  by DBIA 10 112
  775   "RTN","PSO HLDS1",6,0 )
  776    ;VADPT        supp.  by DBIA 10 061
  777   "RTN","PSO HLDS1",7,0 )
  778    ;EN^DIQ1      supp.  by DBIA 10 0
  779   "RTN","PSO HLDS1",8,0 )
  780    ;EN^VAFHL ZTA supp.  by DBIA 75 8
  781   "RTN","PSO HLDS1",9,0 )
  782    ;PSDRUG       supp.  by DBIA 22 1
  783   "RTN","PSO HLDS1",10, 0)
  784    ;PS(50.60 7   supp.  by DBIA 22 21
  785   "RTN","PSO HLDS1",11, 0)
  786    ;PS(55        supp.  by DBIA 22 28
  787   "RTN","PSO HLDS1",12, 0)
  788    ;DPT          supp.  by DBIA 30 97
  789   "RTN","PSO HLDS1",13, 0)
  790    ;SC           supp.  by DBIA 10 040
  791   "RTN","PSO HLDS1",14, 0)
  792    ;VA(200       supp.  by DBIA 10 060
  793   "RTN","PSO HLDS1",15, 0)
  794    ;SCMSVUT5     supp.  by DBIA 43 47
  795   "RTN","PSO HLDS1",16, 0)
  796    ;BLDPID^V AFCQRY sup p. by DBIA  3630
  797   "RTN","PSO HLDS1",17, 0)
  798    ;MAKEIT^V AFHLU  sup p. by DBIA  4346
  799   "RTN","PSO HLDS1",18, 0)
  800    ;
  801   "RTN","PSO HLDS1",19, 0)
  802    ;*232 all ow for Do  Not Mail
  803   "RTN","PSO HLDS1",20, 0)
  804    ;*255 mov e NTEPMI t o PSOHLDS4 .  fix "MP " node tes t to '=""
  805   "RTN","PSO HLDS1",21, 0)
  806    ;*305 sen d  Notice  of Privacy  Practices  in NTE9 -  Modified  to NTE9 as  NTE8 alre ady exist
  807   "RTN","PSO HLDS1",22, 0)
  808    ;*524 add ed ZZZ seg ment for h azardous d rug inform ation
  809   "RTN","PSO HLDS1",23, 0)
  810    ;
  811   "RTN","PSO HLDS1",24, 0)
  812   START ;
  813   "RTN","PSO HLDS1",25, 0)
  814    D GETDATA
  815   "RTN","PSO HLDS1",26, 0)
  816    D PID(.PS I),PV1(.PS I),PV2(.PS I),IAM^PSO HLDS4(.PSI ),ORC^PSOH LDS4(.PSI)
  817   "RTN","PSO HLDS1",27, 0)
  818    D NTE^PSO HLDS2,RXE^ PSOHLDS2(. PSI),RXD^P SOHLDS2(.P SI)
  819   "RTN","PSO HLDS1",28, 0)
  820    D NTEPMI^ PSOHLDS4(. PSI),NTE9^ PSOHLDS2(. PSI),RXR^P SOHLDS2(.P SI),ZZZ^PS OHLDS2(.PS I)                 ;* 255 ;*524  added ZZZ  segment fo r hazardou s flags
  821   "RTN","PSO HLDS1",29, 0)
  822    ; clean u p data set  by GETDAT A
  823   "RTN","PSO HLDS1",30, 0)
  824    K EBY,EBY 1,EFDT,EXD T,FDT,PVDR ,PVDR1,CSI NER,CSINER 1,SITE,SIT ADD,SITPHN
  825   "RTN","PSO HLDS1",31, 0)
  826    K VPHARMI D,VPHARM,D EAID,MW,QT Y,DASPLY,O LAN,OTHLAN ,PRIORDT,R FRM,NFLD,W ARN
  827   "RTN","PSO HLDS1",32, 0)
  828    K PSOXN,P SOXN2,PSND 1,PSND2,PR ODUCT,PSOP ROD,UNIT,V ANAME,DISP DT,PSONDC
  829   "RTN","PSO HLDS1",33, 0)
  830    K DRUG
  831   "RTN","PSO HLDS1",34, 0)
  832    Q
  833   "RTN","PSO HLDS1",35, 0)
  834   GETDATA ;  this is th e place to  set all d ata needed  for sever al segment s
  835   "RTN","PSO HLDS1",36, 0)
  836    I $G(FP)= "F"&('$G(F PN)) D     ;original
  837   "RTN","PSO HLDS1",37, 0)
  838    . S FDT=$ P(^PSRX(IR XN,2),"^", 2),VPHARMI D=$P(^(2), "^",10),DI SPDT=$P(^( 2),"^",5), EXDT=$P(^( 2),"^",6), PSONDC=$P( ^(2),"^",7 )
  839   "RTN","PSO HLDS1",38, 0)
  840    . S PVDR= $P(^PSRX(I RXN,0),"^" ,4),QTY=$P (^(0),"^", 7),DASPLY= $P(^(0),"^ ",8),MW=$P (^(0),"^", 11),EBY=$P (^(0),"^", 16)
  841   "RTN","PSO HLDS1",39, 0)
  842    I $G(FP)= "F"&($G(FP N)) D    ; refill
  843   "RTN","PSO HLDS1",40, 0)
  844    . S FDT=$ P(^PSRX(IR XN,1,FPN,0 ),"^"),MW= $P(^(0),"^ ",2),QTY=$ P(^(0),"^" ,4),DASPLY =$P(^(0)," ^",10),DIS PDT=$P(^(0 ),"^",19), EXDT=$S($P (^(0),"^", 15):$P(^(0 ),"^",15), 1:$P(^PSRX (IRXN,2)," ^",6))
  845   "RTN","PSO HLDS1",41, 0)
  846    . S VPHAR MID=$S($P( ^PSRX(IRXN ,1,FPN,0), "^",5)'="" :$P(^(0)," ^",5),1:$P (^PSRX(IRX N,2),"^",1 0))
  847   "RTN","PSO HLDS1",42, 0)
  848    . S EBY=$ S($P(^PSRX (IRXN,1,FP N,0),"^",5 ):$P(^(0), "^",5),1:$ P(^(0),"^" ,7)),PVDR= $P(^(0),"^ ",17),PSON DC=$S($P($ G(^PSRX(IR XN,1,FPN,1 )),"^",3): $P(^(1),"^ ",3),1:$P( ^PSRX(IRXN ,2),"^",7) )
  849   "RTN","PSO HLDS1",43, 0)
  850    I $G(FP)= "P"&($G(FP N)) D  ;pa rtial
  851   "RTN","PSO HLDS1",44, 0)
  852    . S FDT=$ P(^PSRX(IR XN,"P",FPN ,0),"^"),M W=$P(^(0), "^",2),QTY =$P(^(0)," ^",4),DASP LY=$P(^(0) ,"^",10),D ISPDT=FDT, PVDR=$P(^( 0),"^",17) ,EXDT=$P(^ PSRX(IRXN, 2),"^",6)
  853   "RTN","PSO HLDS1",45, 0)
  854    . S EBY=$ S($P(^PSRX (IRXN,"P", FPN,0),"^" ,5):$P(^(0 ),"^",5),1 :$P(^(0)," ^",7)),VPH ARMID=$S($ P(^(0),"^" ,5)'="":$P (^(0),"^", 5),1:$P(^P SRX(IRXN,2 ),"^",10)) ,PVDR=$P(^ PSRX(IRXN, "P",FPN,0) ,"^",17)
  855   "RTN","PSO HLDS1",46, 0)
  856    . S PSOND C=$S($P(^P SRX(IRXN," P",FPN,0), "^",12):$P (^(0),"^", 12),1:$P(^ PSRX(IRXN, 2),"^",7))
  857   "RTN","PSO HLDS1",47, 0)
  858    S EFDT=$P (^PSRX(IRX N,2),"^",2 ) S:$G(EFD T) EFDT=$$ HLDATE^HLF NC(EFDT,"D T")
  859   "RTN","PSO HLDS1",48, 0)
  860    S ISDT=$P (^PSRX(IRX N,0),"^",1 3) S:$G(IS DT) ISDT=$ $HLDATE^HL FNC(ISDT," DT")
  861   "RTN","PSO HLDS1",49, 0)
  862    S DEAID=$ $GET1^DIQ( 200,PVDR_" ,",53.2)
  863   "RTN","PSO HLDS1",50, 0)
  864    K DIC,X,Y  S DIC="^V A(200,",DI C(0)="N,Z" ,X=VPHARMI D D ^DIC
  865   "RTN","PSO HLDS1",51, 0)
  866    S VPHARM= $S(+Y:$$HL NAME^HLFNC ($P(Y,"^", 2)),1:"""" "") K DIC, X,Y
  867   "RTN","PSO HLDS1",52, 0)
  868    K DIC,X,Y  S DIC="^V A(200,",DI C(0)="N,Z" ,X=EBY D ^ DIC
  869   "RTN","PSO HLDS1",53, 0)
  870    S EBY1=$S (+Y:$$HLNA ME^HLFNC($ P(Y,"^",2) ),1:"""""" ) K DIC,X, Y
  871   "RTN","PSO HLDS1",54, 0)
  872    K DIC,X,Y  S DIC="^V A(200,",DI C(0)="N,Z" ,X=PVDR D  ^DIC
  873   "RTN","PSO HLDS1",55, 0)
  874    S PVDR1=$ S(+Y:$$HLN AME^HLFNC( $P(Y,"^",2 )),1:""""" ") K DIC,X ,Y
  875   "RTN","PSO HLDS1",56, 0)
  876    S PRIORDT =$P(^PSRX( IRXN,3),"^ ",4),PRIOR DT=$$HLDAT E^HLFNC(PR IORDT,"DT" )
  877   "RTN","PSO HLDS1",57, 0)
  878    S FDT=$$H LDATE^HLFN C(FDT,"DT" )
  879   "RTN","PSO HLDS1",58, 0)
  880    S:$G(DISP DT) DISPDT =$$HLDATE^ HLFNC(DISP DT,"DT")
  881   "RTN","PSO HLDS1",59, 0)
  882    S:$G(EXDT ) EXDT=$$H LDATE^HLFN C(EXDT,"DT ")
  883   "RTN","PSO HLDS1",60, 0)
  884    S FIN=$P( ^PSRX(IRXN ,"OR1"),"^ ",5)
  885   "RTN","PSO HLDS1",61, 0)
  886    K DIC,X,Y  S DIC="^V A(200,",DI C(0)="N,Z" ,X=FIN D ^ DIC
  887   "RTN","PSO HLDS1",62, 0)
  888    S FIN1=$S (+Y:$$HLNA ME^HLFNC($ P(Y,"^",2) ),1:"""""" ) K DIC,X, Y
  889   "RTN","PSO HLDS1",63, 0)
  890    S SITE=$S ($D(^PS(59 ,PSOSITE,0 )):^(0),1: "")
  891   "RTN","PSO HLDS1",64, 0)
  892    S PSZIP=$ P(SITE,"^" ,5) S PSOH ZIP=$S(PSZ IP["-":PSZ IP,1:$E(PS ZIP,1,5)_$ S($E(PSZIP ,6,9)]"":" -"_$E(PSZI P,6,9),1:" "))
  893   "RTN","PSO HLDS1",65, 0)
  894    S CLN=+$P (^PSRX(IRX N,0),"^",5 ),CLN1=$S( $D(^SC(CLN ,0)):$P(^( 0),"^",1), 1:"UNKNOWN ")
  895   "RTN","PSO HLDS1",66, 0)
  896    S CSINER= $P(^PSRX(I RXN,3),"^" ,3)
  897   "RTN","PSO HLDS1",67, 0)
  898    K DIC,X,Y  S DIC="^V A(200,",DI C(0)="N,Z" ,X=CSINER  D ^DIC
  899   "RTN","PSO HLDS1",68, 0)
  900    S CSINER1 =$S(+Y:$$H LNAME^HLFN C($P(Y,"^" ,2)),1:""" """) K DIC ,X,Y
  901   "RTN","PSO HLDS1",69, 0)
  902    D 6^VADPT
  903   "RTN","PSO HLDS1",70, 0)
  904    S X=$S($D (^PS(55,DF N,0)):^(0) ,1:""),CAP =$P(X,"^", 2)
  905   "RTN","PSO HLDS1",71, 0)
  906    D MW(X,.M W,.MP)                                                   ;PSO*232
  907   "RTN","PSO HLDS1",72, 0)
  908    I (($P(^P SRX(IRXN," STA"),"^") >0)&($P(^( "STA"),"^" )'=2)&('$G (PSODBQ))) !'$G(^PSRX (IRXN,"IB" )) S COPAY ="NO COPAY "
  909   "RTN","PSO HLDS1",73, 0)
  910    E  S COPA Y="COPAY"
  911   "RTN","PSO HLDS1",74, 0)
  912    S NURSE=$ S($P($G(^D PT(DFN,"NH C")),"^")= "Y":1,$P($ G(^PS(55,D FN,40)),"^ "):1,1:0)
  913   "RTN","PSO HLDS1",75, 0)
  914    S DATE=$$ HLDATE^HLF NC(FDT) D  NOW^%DTC S  NOW=$$HLD ATE^HLFNC( %,"TS")
  915   "RTN","PSO HLDS1",76, 0)
  916    S OLAN=$P ($G(^PS(55 ,DFN,"LAN" )),"^",2), OTLAN="N"  I OLAN=2 S  OTLAN="Y"
  917   "RTN","PSO HLDS1",77, 0)
  918    S CSUB1=$ $GET1^DIQ( 50,IDGN_", ",3),CSUB= "N" I $E(C SUB1,1)>1& ($E(CSUB1, 1)<6) S CS UB="Y"
  919   "RTN","PSO HLDS1",78, 0)
  920    S SCTALK= +$G(^PS(55 ,"ASTALK", $P(^PSRX(I RXN,0),"^" ,2)))
  921   "RTN","PSO HLDS1",79, 0)
  922    K DIC,DR, DIQ S DA=$ P($$SITE^V ASITE(),"^ ") I DA D
  923   "RTN","PSO HLDS1",80, 0)
  924    .K PSOINS T S DIC=4, DIQ(0)="I" ,DR=99,DIQ ="PSOINST"  D EN^DIQ1
  925   "RTN","PSO HLDS1",81, 0)
  926    .S PSOINS T=PSOINST( 4,DA,99,"I ") K DIC,D A,DR,DIQ,P SOINST(4)
  927   "RTN","PSO HLDS1",82, 0)
  928    S DRUG=$$ ZZ^PSOSUTL (IRXN),DEA =$P(^PSDRU G(IDGN,0), "^",3),WAR N=$P($G(^( 0)),"^",8)
  929   "RTN","PSO HLDS1",83, 0)
  930    S PSND1=$ P($G(^PSDR UG(IDGN,"N D")),"^"), PSND2=$P($ G(^("ND")) ,"^",2),PS ND3=$P($G( ^("ND"))," ^",3)
  931   "RTN","PSO HLDS1",84, 0)
  932    K PSOXN,P SOXN2,PSOP ROD
  933   "RTN","PSO HLDS1",85, 0)
  934    I PSND1,P SND3 D
  935   "RTN","PSO HLDS1",86, 0)
  936    .S PSOPRO D=$$PROD2^ PSNAPIS(PS ND1,PSND3) ,VANAME=$P ($G(PSOPRO D),"^",1)
  937   "RTN","PSO HLDS1",87, 0)
  938    .I $T(^PS NAPIS)]""  S PSOXN=$$ DFSU^PSNAP IS(PSND1,P SND3),UNIT =$P($G(PSO XN),"^",6)  S PSOXN=$ P($G(PSOXN ),"^",5) S  PSOXN2=$$ PROD2^PSNA PIS(PSND1, PSND3) Q
  939   "RTN","PSO HLDS1",88, 0)
  940    .S PSOXN2 =$G(^PSNDF (PSND1,5,P SND3,2))
  941   "RTN","PSO HLDS1",89, 0)
  942    .S PRODUC T=$G(^PSND F(PSND1,5, PSND3,0))
  943   "RTN","PSO HLDS1",90, 0)
  944    .I $G(PRO DUCT)'=""  S PSOXN=+$ P($G(^PSND F(PSND1,2, +$P(PRODUC T,"^",2),3 ,+$P(PRODU CT,"^",3), 4,+$P(PROD UCT,"^",4) ,0)),"^"), UNIT=$P($G (^PS(50.60 7,PSOXN,0) ),"^")
  945   "RTN","PSO HLDS1",91, 0)
  946    S NFLD=0, UU="" F  S  UU=$O(^PS RX(IRXN,1, UU)) Q:UU= ""  S:$D(^ PSRX(IRXN, 1,UU,0)) N FLD=NFLD+1
  947   "RTN","PSO HLDS1",92, 0)
  948    S NRFL=$P (^PSRX(IRX N,0),"^",9 ),RFRM=(NR FL-NFLD)
  949   "RTN","PSO HLDS1",93, 0)
  950    Q
  951   "RTN","PSO HLDS1",94, 0)
  952   PID(PSI) ; patient ID  segment
  953   "RTN","PSO HLDS1",95, 0)
  954    Q:'$D(DFN )!$D(PAS)
  955   "RTN","PSO HLDS1",96, 0)
  956    S HLFS=HL 1("FS"),HL ECH=HL1("E CH"),HLQ=H L1("Q"),HL VER=HL1("V ER")
  957   "RTN","PSO HLDS1",97, 0)
  958    K PSPID,P SPID1
  959   "RTN","PSO HLDS1",98, 0)
  960    D BLDPID^ VAFCQRY(DF N,"","3,4, 5,7,8,11,1 3",.PSPID, .HL1,.ERR)
  961   "RTN","PSO HLDS1",99, 0)
  962    ; put PID  in format  needed fo r segment  parser
  963   "RTN","PSO HLDS1",100 ,0)
  964    S PSPID=P SPID(1) K  PSPID(1)
  965   "RTN","PSO HLDS1",101 ,0)
  966    S (X,Y)=1  F  S X=+$ O(PSPID(X) ) Q:'X  S  PSPID(Y)=P SPID(X),Y= Y+1 K PSPI D(X)
  967   "RTN","PSO HLDS1",102 ,0)
  968    ;parse PI D into ind ividual fi elds
  969   "RTN","PSO HLDS1",103 ,0)
  970    K PRSEPID  D SEGPRSE ^SCMSVUT5( "PSPID","P RSEPID",HL 1("FS"))
  971   "RTN","PSO HLDS1",104 ,0)
  972    ; parse a ddress int o individu al compone nts
  973   "RTN","PSO HLDS1",105 ,0)
  974    K ADDSEQ  D SEQPRSE^ SCMSVUT5($ NA(PRSEPID (11)),"ADD SEQ",HL1(" ECH"))
  975   "RTN","PSO HLDS1",106 ,0)
  976    ; build Z TA (Tempor ary Addres s)
  977   "RTN","PSO HLDS1",107 ,0)
  978    K X2 S X2 =$$EN^VAFH LZTA(DFN," 1,2,3,4,5, 6,7,",1)
  979   "RTN","PSO HLDS1",108 ,0)
  980    ; parse X 2 (ZTA) in to individ ual fields  if temp a dd. exists
  981   "RTN","PSO HLDS1",109 ,0)
  982    D:'$$CHKT EMP^PSOBAI (DFN)
  983   "RTN","PSO HLDS1",110 ,0)
  984    . N BADA  S BADA=$$C HKRX^PSOBA I(IRXN)
  985   "RTN","PSO HLDS1",111 ,0)
  986    . I $P(BA DA,"^"),'$ P(BADA,"^" ,2),ADDSEQ (1,7)'["VA B" S BADA= $$GET1^DIQ (2,DFN_"," ,.121,"I")  S:BADA AD DSEQ(1,7)= "VAB"_BADA
  987   "RTN","PSO HLDS1",112 ,0)
  988    D:$$CHKTE MP^PSOBAI( DFN)
  989   "RTN","PSO HLDS1",113 ,0)
  990    . K PRSEZ TA D SEGPR SE^SCMSVUT 5("X2","PR SEZTA",HL1 ("FS"))
  991   "RTN","PSO HLDS1",114 ,0)
  992    . ; parse  temporary  address i nto indivi dual compo nents
  993   "RTN","PSO HLDS1",115 ,0)
  994    . K TMPAD D D SEQPRS E^SCMSVUT5 ($NA(PRSEZ TA(5)),"TM PADD",HL1( "ECH"))
  995   "RTN","PSO HLDS1",116 ,0)
  996    . ; add t emporary a ddress as  next repit ition in P ID segment
  997   "RTN","PSO HLDS1",117 ,0)
  998    . S SPOT= 1+$O(ADDSE Q(""),-1)
  999   "RTN","PSO HLDS1",118 ,0)
  1000    . M ADDSE Q(SPOT)=TM PADD(1)
  1001   "RTN","PSO HLDS1",119 ,0)
  1002    . S ADDSE Q(SPOT,7)= "C"
  1003   "RTN","PSO HLDS1",120 ,0)
  1004    . S ADDSE Q(SPOT,9)= PRSEZTA(6)
  1005   "RTN","PSO HLDS1",121 ,0)
  1006    . S ADDSE Q(SPOT,12, 1)=PRSEZTA (3)
  1007   "RTN","PSO HLDS1",122 ,0)
  1008    . S ADDSE Q(SPOT,12, 2)=PRSEZTA (4)
  1009   "RTN","PSO HLDS1",123 ,0)
  1010    . ;move a ddress seq uence back  into pars e PID segm ent
  1011   "RTN","PSO HLDS1",124 ,0)
  1012    ; rebuild  PID segme nt
  1013   "RTN","PSO HLDS1",125 ,0)
  1014    K PRSEPID (11) M PRS EPID(11)=A DDSEQ
  1015   "RTN","PSO HLDS1",126 ,0)
  1016    K PSPID1  D MAKEIT^V AFHLU("PID ",.PRSEPID ,.PSPID1,. PSPID1)
  1017   "RTN","PSO HLDS1",127 ,0)
  1018    ;put rebu ilt PID in to format  used by $$ EN^VAFCQRY
  1019   "RTN","PSO HLDS1",128 ,0)
  1020    K PSPID S  PSPID(1)= PSPID1
  1021   "RTN","PSO HLDS1",129 ,0)
  1022    S X=0,Y=2  F  S X=+$ O(PSPID1(X )) Q:'X  S  PSPID(Y)= PSPID1(X)  S Y=Y+1
  1023   "RTN","PSO HLDS1",130 ,0)
  1024    S CNT=0 F  I=1:1 Q:' $D(PSPID(I ))  D
  1025   "RTN","PSO HLDS1",131 ,0)
  1026    . I I=1 S  ^TMP("PSO ",$J,PSI)= PSPID(I) Q
  1027   "RTN","PSO HLDS1",132 ,0)
  1028    . S CNT=C NT+1 S ^TM P("PSO",$J ,PSI,CNT)= PSPID(I)
  1029   "RTN","PSO HLDS1",133 ,0)
  1030    S PSI=PSI +1
  1031   "RTN","PSO HLDS1",134 ,0)
  1032    S PAS=1
  1033   "RTN","PSO HLDS1",135 ,0)
  1034    K PSPID,P SPID1,PRSE PID,PRSEZT A,SPOT,TMP ADD,ADDSEQ
  1035   "RTN","PSO HLDS1",136 ,0)
  1036    Q
  1037   "RTN","PSO HLDS1",137 ,0)
  1038   PV1(PSI) ; patient vi sit segmen t
  1039   "RTN","PSO HLDS1",138 ,0)
  1040    Q:'$D(DFN )!$D(PAS1)
  1041   "RTN","PSO HLDS1",139 ,0)
  1042    N PV1  ;h ardcoded t o letter O  for Outpa tient (Pat ient class )
  1043   "RTN","PSO HLDS1",140 ,0)
  1044    S PV1="PV 1"_FS_FS_" O"_FS
  1045   "RTN","PSO HLDS1",141 ,0)
  1046    S ^TMP("P SO",$J,PSI )=PV1
  1047   "RTN","PSO HLDS1",142 ,0)
  1048    S PSI=PSI +1,PAS1=1
  1049   "RTN","PSO HLDS1",143 ,0)
  1050    Q
  1051   "RTN","PSO HLDS1",144 ,0)
  1052   PV2(PSI) ; patient vi sit segmen t (additio nal inform ation)
  1053   "RTN","PSO HLDS1",145 ,0)
  1054    ;PATIENT  STATUS AND  COPAY
  1055   "RTN","PSO HLDS1",146 ,0)
  1056    Q:'$D(DFN )!$D(PAS2)
  1057   "RTN","PSO HLDS1",147 ,0)
  1058    N PV2 S P V2=""
  1059   "RTN","PSO HLDS1",148 ,0)
  1060    S $P(PV2, "|",24)=$P ($G(^PS(53 ,+$P($G(^P SRX(IRXN,0 )),"^",3), 0)),"^",2) _"~"_COPAY _FS
  1061   "RTN","PSO HLDS1",149 ,0)
  1062    S ^TMP("P SO",$J,PSI )="PV2|"_P V2
  1063   "RTN","PSO HLDS1",150 ,0)
  1064    S PSI=PSI +1,PAS2=1
  1065   "RTN","PSO HLDS1",151 ,0)
  1066    Q
  1067   "RTN","PSO HLDS1",152 ,0)
  1068    ;
  1069   "RTN","PSO HLDS1",153 ,0)
  1070   MW(PS55,MW ,MP) ;Retu rn Mail/Wi ndow and M P expanded  text                 ;PSO*232
  1071   "RTN","PSO HLDS1",154 ,0)
  1072    I MW="W"! (MW="") D                     ;* 255
  1073   "RTN","PSO HLDS1",155 ,0)
  1074    . S MP=$S ($P($G(^PS RX(IRXN,"M P")),"^")' ="":$P(^(" MP"),"^"), 1:"""""")
  1075   "RTN","PSO HLDS1",156 ,0)
  1076    . S MW="W INDOW"
  1077   "RTN","PSO HLDS1",157 ,0)
  1078    I MW="M"  D
  1079   "RTN","PSO HLDS1",158 ,0)
  1080    . S MP="" """"
  1081   "RTN","PSO HLDS1",159 ,0)
  1082    . S PS55= $P(PS55,"^ ",3)
  1083   "RTN","PSO HLDS1",160 ,0)
  1084    . S MW=$S (PS55=1:"C ERTIFIED M AIL",PS55= 2:"DO NOT  MAIL",1:"R EGULAR MAI L")
  1085   "RTN","PSO HLDS1",161 ,0)
  1086    Q
  1087   "RTN","PSO HLDS2")
  1088   0^3^B98255 192
  1089   "RTN","PSO HLDS2",1,0 )
  1090   PSOHLDS2 ; BHAM ISC/P WC,SAB-Bui ld HL7 Seg ments for  automated  interface  ;11/22/06  3:24pm
  1091   "RTN","PSO HLDS2",2,0 )
  1092    ;;7.0;OUT PATIENT PH ARMACY;**1 56,198,255 ,200,268,3 05,336,434 ,282,524** ;DEC 1997; Build 12
  1093   "RTN","PSO HLDS2",3,0 )
  1094    ;DIWP sup ported by  DBIA 10011
  1095   "RTN","PSO HLDS2",4,0 )
  1096    ;^PS(50.6 06 support ed by DBIA  2174
  1097   "RTN","PSO HLDS2",5,0 )
  1098    ;^PS(50.7  supported  by DBIA # 2223
  1099   "RTN","PSO HLDS2",6,0 )
  1100    ;^PS(51 s upported b y DBIA 222 4
  1101   "RTN","PSO HLDS2",7,0 )
  1102    ;^PS(51.2  supported  by DBIA 2 226
  1103   "RTN","PSO HLDS2",8,0 )
  1104    ;^PS(55 s upported b y DBIA 222 8
  1105   "RTN","PSO HLDS2",9,0 )
  1106    ;^PSDRUG  supported  by DBIA 22 1
  1107   "RTN","PSO HLDS2",10, 0)
  1108    ;^PS(54 s upported b y DBIA 222 7
  1109   "RTN","PSO HLDS2",11, 0)
  1110    ;Cont'd b uild HL7 s egments
  1111   "RTN","PSO HLDS2",12, 0)
  1112    ;
  1113   "RTN","PSO HLDS2",13, 0)
  1114    ;*198 add  check to  insert spa ces into P MI segment s
  1115   "RTN","PSO HLDS2",14, 0)
  1116    ;*255 add  2 new fie lds to RXE .21 (label  name & VA  PRINT NAM E)
  1117   "RTN","PSO HLDS2",15, 0)
  1118    ;     and  move NTEP MI tag to  PSOHLDS4
  1119   "RTN","PSO HLDS2",16, 0)
  1120    ;*305 sen d  Notice  of Privacy  Practices  in NTE9 -  Modified  to NTE9 as  NTE8 alre ady exist
  1121   "RTN","PSO HLDS2",17, 0)
  1122    ;
  1123   "RTN","PSO HLDS2",18, 0)
  1124    ;
  1125   "RTN","PSO HLDS2",19, 0)
  1126   RXE(PSI) ; pharmacy e ncoded ord er segment
  1127   "RTN","PSO HLDS2",20, 0)
  1128    Q:'$D(DFN )  N RXE S  RXE="" S  $P(RXE,"|" ,1)=""""""
  1129   "RTN","PSO HLDS2",21, 0)
  1130    S $P(RXE, "|",2)=$S( $P($G(^PSD RUG(IDGN," ND")),"^", 10)'="":$P (^("ND")," ^",10),($G (PSND1)&$G (PSND3)):$ P($G(PSOXN 2),"^",2), 1:"""""")_ CS_$G(PSND 2)_CS_"99P SNDF"_CS_P SND1_"."_P SND3_"."_$ G(IDGN)_CS _$P($G(^PS DRUG(IDGN, 0)),"^")_C S_"99PSD"
  1131   "RTN","PSO HLDS2",22, 0)
  1132    S $P(RXE, "|",3)=""  I $G(PSOXN )="" S PSO XN=""""""
  1133   "RTN","PSO HLDS2",23, 0)
  1134    S $P(RXE, "|",5)=PSO XN_CS_$S($ G(UNIT)'=" ":$G(UNIT) ,1:"""""") _CS_"99PSU "
  1135   "RTN","PSO HLDS2",24, 0)
  1136    S POIPTR= $P($G(^PSR X(IRXN,"OR 1")),"^")  I POIPTR S  PODOSE=$P ($G(^PS(50 .7,POIPTR, 0)),"^",2) ,PODOSENM= $P($G(^PS( 50.606,POD OSE,0)),"^ ")
  1137   "RTN","PSO HLDS2",25, 0)
  1138    I '$G(POI PTR) S POD OSE=$P($G( ^PS(50.7,$ P($G(^PSDR UG(IDGN,2) ),"^"),0)) ,"^",2),PO DOSENM=$P( $G(^PS(50. 606,PODOSE ,0)),"^")
  1139   "RTN","PSO HLDS2",26, 0)
  1140    S TRADENM =$G(^PSRX( IRXN,"TN") ),$P(RXE," |",6)=PODO SE_CS_PODO SENM_CS_"9 9PSF"
  1141   "RTN","PSO HLDS2",27, 0)
  1142    S $P(RXE, "|",8)=MP, $P(RXE,"|" ,9)=TRADEN M,$P(RXE," |",10)=QTY
  1143   "RTN","PSO HLDS2",28, 0)
  1144    S $P(RXE, "|",11)=CS _$P($G(^PS DRUG(IDGN, 660)),"^", 8),$P(RXE, "|",12)=NR FL
  1145   "RTN","PSO HLDS2",29, 0)
  1146    S $P(RXE, "|",13)=DE AID,$P(RXE ,"|",14)=V PHARMID_CS _$P(VPHARM ,",",1)_CS _$P(VPHARM ,",",2)
  1147   "RTN","PSO HLDS2",30, 0)
  1148    S $P(RXE, "|",15)=$P (^PSRX(IRX N,0),"^"), $P(RXE,"|" ,16)=RFRM, $P(RXE,"|" ,17)=NFLD
  1149   "RTN","PSO HLDS2",31, 0)
  1150    S $P(RXE, "|",18)=PR IORDT,$P(R XE,"|",31) =CSUB_RS_S CTALK_RS_O TLAN
  1151   "RTN","PSO HLDS2",32, 0)
  1152    S $P(RXE, "|",21)=CS _DRUG_RS_C S_$G(VANAM E)                         ;*255
  1153   "RTN","PSO HLDS2",33, 0)
  1154    S ^TMP("P SO",$J,PSI )="RXE|"_R XE,PSI=PSI +1
  1155   "RTN","PSO HLDS2",34, 0)
  1156    K PODOSE, PODOSENM,P OIPTR,TRAD ENM,UU
  1157   "RTN","PSO HLDS2",35, 0)
  1158    Q
  1159   "RTN","PSO HLDS2",36, 0)
  1160   RXD(PSI) ; pharmacy d ispense se gment
  1161   "RTN","PSO HLDS2",37, 0)
  1162    Q:'$D(DFN )  N RXD,I
  1163   "RTN","PSO HLDS2",38, 0)
  1164    S WNS=""  I $G(WARN)  F I=1:1 S  WW=$P(WAR N,",",I) Q :WW=""  S  WNS=WNS_WW _CS_$S(WW' ["N":^PS(5 4,WW,0),1: "")_RS
  1165   "RTN","PSO HLDS2",39, 0)
  1166    S RXD="RX D"_FS_$S($ G(NFLD):NF LD,1:0)_FS _$S($P($G( ^PSDRUG(ID GN,"ND")), "^",10)'=" ":$P(^("ND "),"^",10) ,($G(PSND1 )&$G(PSND3 )):$P($G(P SOXN2),"^" ,2),1:"""" "")_CS_PSN D2_CS_"99P SNDF"
  1167   "RTN","PSO HLDS2",40, 0)
  1168    S RXD=RXD _CS_PSND1_ "."_PSND3_ "."_$G(IDG N)_CS_$P($ G(^PSDRUG( IDGN,0))," ^")_CS_"99 PSD"
  1169   "RTN","PSO HLDS2",41, 0)
  1170    S RXD=RXD _FS_DISPDT _FS_FS_FS_ FS_$P(^PSR X(IRXN,0), "^")_FS_NR FL
  1171   "RTN","PSO HLDS2",42, 0)
  1172    S RXD=RXD _FS_DEA_RS _PSONDC_FS _$S(FIN'=" ":FIN_CS_F IN1,1:"")_ FS
  1173   "RTN","PSO HLDS2",43, 0)
  1174    S RXD=RXD _FS_DASPLY _FS_MW_FS_ FS_CS_$S($ G(CAP):"NO N-SAFETY", 1:"SAFETY" )
  1175   "RTN","PSO HLDS2",44, 0)
  1176    S RXD=RXD _FS_FS_FS_ FS_EXDT_FS _FS_FS_FS_ FS_FS_WNS_ FS_FS
  1177   "RTN","PSO HLDS2",45, 0)
  1178    S ^TMP("P SO",$J,PSI )=RXD,PSI= PSI+1
  1179   "RTN","PSO HLDS2",46, 0)
  1180    Q
  1181   "RTN","PSO HLDS2",47, 0)
  1182   RXR(PSI) ; pharmacy r oute segme nt
  1183   "RTN","PSO HLDS2",48, 0)
  1184    Q:'$D(DFN )  N RXR S  (PSROUTE, RTNAME)="" """"
  1185   "RTN","PSO HLDS2",49, 0)
  1186    F PSRTLP= 0:0 S PSRT LP=$O(^PSR X(IRXN,6,P SRTLP)) Q: 'PSRTLP  D
  1187   "RTN","PSO HLDS2",50, 0)
  1188    .S PSROUT E=$P($G(^P SRX(IRXN,6 ,PSRTLP,0) ),"^",7)
  1189   "RTN","PSO HLDS2",51, 0)
  1190    .I PSROUT E,$D(^PS(5 1.2,PSROUT E,0))  S R TNAME=$P(^ PS(51.2,PS ROUTE,0)," ^")
  1191   "RTN","PSO HLDS2",52, 0)
  1192    I RTNAME= "" K PSROU TE,RTNAME, PSRTLP Q
  1193   "RTN","PSO HLDS2",53, 0)
  1194    S RXR="RX R"_FS_$G(P SROUTE)_CS _$G(RTNAME )_CS_"99PS R"_FS_FS_F S_FS
  1195   "RTN","PSO HLDS2",54, 0)
  1196    S ^TMP("P SO",$J,PSI )=RXR,PSI= PSI+1
  1197   "RTN","PSO HLDS2",55, 0)
  1198    K PSROUTE ,RTNAME,PS RTLP
  1199   "RTN","PSO HLDS2",56, 0)
  1200    Q
  1201   "RTN","PSO HLDS2",57, 0)
  1202   SIG K OT S  SGY="" F  P=1:1:$L(S IG," ") S  X=$P(SIG,"  ",P) D:X] ""
  1203   "RTN","PSO HLDS2",58, 0)
  1204    .I $D(^PS (51,"A",X) ) D
  1205   "RTN","PSO HLDS2",59, 0)
  1206    ..;PSO*7* 282 Intend ed Use
  1207   "RTN","PSO HLDS2",60, 0)
  1208    ..I $P($G (^PS(55,DF N,"LAN")), "^") S OT= $O(^PS(51, "B",X,0))  I OT,($P(^ PS(51,OT,0 ),"^",4)<2 )&($P($G(^ PS(51,OT,4 )),"^")]"" ) S X=$P(^ PS(51,OT,4 ),"^") K O T Q
  1209   "RTN","PSO HLDS2",61, 0)
  1210    ..;S %=^P S(51,"A",X ),X=$P(%," ^") I $P(% ,"^",2)]""  S Y=$P(SI G," ",P-1) ,Y=$E(Y,$L (Y)) S:Y>1  X=$P(%,"^ ",2)
  1211   "RTN","PSO HLDS2",62, 0)
  1212    .S SGY=SG Y_X_" "
  1213   "RTN","PSO HLDS2",63, 0)
  1214    S X="",SG C=1 F J=1: 1 S Z=$P(S GY," ",J)  S:Z="" SGY (SGC)=X Q: Z=""  S:$L (X)+$L(Z)' <$S($P(PSO PAR,"^",28 ):46,1:34)  SGY(SGC)= X,SGC=SGC+ 1,X="" S X =X_Z_" "
  1215   "RTN","PSO HLDS2",64, 0)
  1216   SIGOLD I ' $P(PSOPAR, "^",28) D   K NHC
  1217   "RTN","PSO HLDS2",65, 0)
  1218    .K DIC,DR ,DIQ,NHC S  DIC=2,DA= DFN,DR=148 ,DIQ="NHC" ,DIQ(0)="I "
  1219   "RTN","PSO HLDS2",66, 0)
  1220    .D EN^DIQ 1 K DIC,DR ,DIQ
  1221   "RTN","PSO HLDS2",67, 0)
  1222    .I NHC(2, DFN,148,"I ")="Y"!($P ($G(^PS(55 ,DFN,40)), "^")) S SG C=SGC+1,SG Y(SGC)="Ex piration:_ _______ Mf g:________ _"
  1223   "RTN","PSO HLDS2",68, 0)
  1224    Q
  1225   "RTN","PSO HLDS2",69, 0)
  1226    ;
  1227   "RTN","PSO HLDS2",70, 0)
  1228   PSOLBL3 ;R X must be  defined (I nternal),  Check alre ady done f or OERR SI G
  1229   "RTN","PSO HLDS2",71, 0)
  1230    ;Format O ERR Sig fo r New and  Old label  stock
  1231   "RTN","PSO HLDS2",72, 0)
  1232    N CTCT,FF FF,LLIM,LL LL,LVAR,LV AR1,PPP,PP PP,SGCT,SI G9,ZZZZ,PS LONG,PPPP
  1233   "RTN","PSO HLDS2",73, 0)
  1234    S RX=IRXN
  1235   "RTN","PSO HLDS2",74, 0)
  1236    I $P($G(^ PS(55,DFN, "LAN")),"^ ") N II D  OTHL^PSOLB L3 G:$G(FN D) FMSIG
  1237   "RTN","PSO HLDS2",75, 0)
  1238    S PSLONG= $S($P(PSOP AR,"^",28) :46,1:34)
  1239   "RTN","PSO HLDS2",76, 0)
  1240    ; NEXT LI NE IF SIG  IS MOVED B ACK TO MUL TIPLE
  1241   "RTN","PSO HLDS2",77, 0)
  1242    S PPPP=1  F PPP=0:0  S PPP=$O(^ PSRX(RX,"S IG1",PPP))  Q:'PPP  I  $G(^PSRX( RX,"SIG1", PPP,0))'=" " S SIG9(P PPP)=^(0)  S PPPP=PPP P+1
  1243   "RTN","PSO HLDS2",78, 0)
  1244    ;NEXT LIN E IF 1ST F RONT DOOR  SIG LINE L IVES IN BA CK DOOR SP OT
  1245   "RTN","PSO HLDS2",79, 0)
  1246   FMSIG S (L VAR,LVAR1) ="",LLLL=1
  1247   "RTN","PSO HLDS2",80, 0)
  1248    F FFFF=0: 0 S FFFF=$ O(SIG9(FFF F)) Q:'FFF F  S SGCT= 0 F ZZZZ=1 :1:$L(SIG9 (FFFF)) I  $E(SIG9(FF FF),ZZZZ)= " "!($L(SI G9(FFFF))= ZZZZ) S SG CT=SGCT+1  D  I $L(LV AR)>PSLONG  S SGY(LLL L)=LLIM_"  ",LLLL=LLL L+1,LVAR=L VAR1
  1249   "RTN","PSO HLDS2",81, 0)
  1250    .S LVAR1= $P(SIG9(FF FF)," ",(S GCT)),LLIM =LVAR,LVAR =$S(LVAR=" ":LVAR1,1: LVAR_" "_L VAR1)
  1251   "RTN","PSO HLDS2",82, 0)
  1252    I $G(LVAR )'="" S SG Y(LLLL)=LV AR
  1253   "RTN","PSO HLDS2",83, 0)
  1254    I '$P(PSO PAR,"^",28 ) S SGC=0  F CTCT=0:0  S CTCT=$O (SGY(CTCT) ) Q:'CTCT   S SGC=SGC +1
  1255   "RTN","PSO HLDS2",84, 0)
  1256    I $O(OSGY (0)) D
  1257   "RTN","PSO HLDS2",85, 0)
  1258    .F I=0:0  S I=$O(SGY (I)) Q:'I   I $G(OSGY (I))']"" S  OSGY(I)="  "
  1259   "RTN","PSO HLDS2",86, 0)
  1260    .F I=0:0  S I=$O(OSG Y(I)) Q:'I   I $G(SGY (I))']"" S  SGY(I)="  "
  1261   "RTN","PSO HLDS2",87, 0)
  1262    Q
  1263   "RTN","PSO HLDS2",88, 0)
  1264   NTE ;build  NTE segme nt for SIG
  1265   "RTN","PSO HLDS2",89, 0)
  1266    ;
  1267   "RTN","PSO HLDS2",90, 0)
  1268    Q:'$D(DFN )
  1269   "RTN","PSO HLDS2",91, 0)
  1270    ; 1 = SIG
  1271   "RTN","PSO HLDS2",92, 0)
  1272    ; 2 = PI  Narrative
  1273   "RTN","PSO HLDS2",93, 0)
  1274    ; 3 = Dru g Warning
  1275   "RTN","PSO HLDS2",94, 0)
  1276    ; 4 = Pro file
  1277   "RTN","PSO HLDS2",95, 0)
  1278    ; 5 = Dru g Interact ion
  1279   "RTN","PSO HLDS2",96, 0)
  1280    ; 6 = Dru g Allergy
  1281   "RTN","PSO HLDS2",97, 0)
  1282    ; 7 = PMI  Sheet (NT EPMI in PS OHLDS4)
  1283   "RTN","PSO HLDS2",98, 0)
  1284    ; 8 = Med ication In structions
  1285   "RTN","PSO HLDS2",99, 0)
  1286    ; 9 = Pri vacy Notif ication
  1287   "RTN","PSO HLDS2",100 ,0)
  1288    ;
  1289   "RTN","PSO HLDS2",101 ,0)
  1290    K FLDX
  1291   "RTN","PSO HLDS2",102 ,0)
  1292    D NTE1(.P SI) K FLDX  D NTE2(.P SI) K FLDX  D NTE3(.P SI) K FLDX
  1293   "RTN","PSO HLDS2",103 ,0)
  1294    D NTE4(.P SI) K FLDX  D NTE5(.P SI) K FLDX  D NTE6(.P SI) K FLDX
  1295   "RTN","PSO HLDS2",104 ,0)
  1296    Q
  1297   "RTN","PSO HLDS2",105 ,0)
  1298    ;
  1299   "RTN","PSO HLDS2",106 ,0)
  1300   NTE1(PSI)  ;SIG
  1301   "RTN","PSO HLDS2",107 ,0)
  1302    S SIG=$P( $G(^PSRX(I RXN,"SIG") ),"^")
  1303   "RTN","PSO HLDS2",108 ,0)
  1304    I $P($G(^ PSRX(IRXN, "SIG")),"^ ",2) D PSO LBL3,SIGOL D
  1305   "RTN","PSO HLDS2",109 ,0)
  1306    I '$P($G( ^PSRX(IRXN ,"SIG"))," ^",2) D SI G
  1307   "RTN","PSO HLDS2",110 ,0)
  1308    I $O(OSGY (0)) D  G  KNTE
  1309   "RTN","PSO HLDS2",111 ,0)
  1310    .K DRR F  DR=0:0 S D R=$O(SGY(D R)) Q:'DR   S DRR=$G( DRR)+1
  1311   "RTN","PSO HLDS2",112 ,0)
  1312    .S DRR=DR R+1,SGY(DR R)=FS_"Med ication In structions  (LANGUAGE  PREFERENC E)"
  1313   "RTN","PSO HLDS2",113 ,0)
  1314    .K DRR F  DR=0:0 S D R=$O(OSGY( DR)) Q:'DR   S DRR=$G (DRR)+1
  1315   "RTN","PSO HLDS2",114 ,0)
  1316    .S DRR=DR R+1,OSGY(D RR)=FS_"Me dication I nstruction s (ENGLISH )"
  1317   "RTN","PSO HLDS2",115 ,0)
  1318    .K DRR S  ^TMP("PSO" ,$J,PSI)=" NTE"_FS_1_ FS_FS
  1319   "RTN","PSO HLDS2",116 ,0)
  1320    .S CLD=1  F DR=0:0 S  DR=$O(OSG Y(DR)) Q:' DR  D
  1321   "RTN","PSO HLDS2",117 ,0)
  1322    ..S:$L($G (^TMP("PSO ",$J,PSI,C LD))_OSGY( DR))>245 C LD=CLD+1 S  ^TMP("PSO ",$J,PSI,C LD)=$G(^TM P("PSO",$J ,PSI,CLD)) _OSGY(DR)
  1323   "RTN","PSO HLDS2",118 ,0)
  1324    .S PSI=PS I+1,^TMP(" PSO",$J,PS I)="NTE"_F S_8_FS_FS
  1325   "RTN","PSO HLDS2",119 ,0)
  1326    .S CLD=1  F DR=0:0 S  DR=$O(SGY (DR)) Q:'D R  D
  1327   "RTN","PSO HLDS2",120 ,0)
  1328    ..S:$L($G (^TMP("PSO ",$J,PSI,C LD))_SGY(D R))>245 CL D=CLD+1 S  ^TMP("PSO" ,$J,PSI,CL D)=$G(^TMP ("PSO",$J, PSI,CLD))_ SGY(DR)
  1329   "RTN","PSO HLDS2",121 ,0)
  1330    K DRR F D R=0:0 S DR =$O(SGY(DR )) Q:'DR   S DRR=$G(D RR)+1
  1331   "RTN","PSO HLDS2",122 ,0)
  1332    S DRR=DRR +1,SGY(DRR )=FS_"Medi cation Ins tructions"
  1333   "RTN","PSO HLDS2",123 ,0)
  1334    K DRR S ^ TMP("PSO", $J,PSI)="N TE"_FS_1_F S_FS
  1335   "RTN","PSO HLDS2",124 ,0)
  1336    S CLD=1 F  DR=0:0 S  DR=$O(SGY( DR)) Q:'DR   D
  1337   "RTN","PSO HLDS2",125 ,0)
  1338    .S:$L($G( ^TMP("PSO" ,$J,PSI,CL D))_SGY(DR ))>245 CLD =CLD+1 S ^ TMP("PSO", $J,PSI,CLD )=$G(^TMP( "PSO",$J,P SI,CLD))_S GY(DR)
  1339   "RTN","PSO HLDS2",126 ,0)
  1340   KNTE S PSI =PSI+1 K D R,CLD,DRR, SIG,E,F,S, FLD1,X,Y,S GY,SGC,Z,D R,%,J,P,NT 1,ST,EN,LT H
  1341   "RTN","PSO HLDS2",127 ,0)
  1342    Q
  1343   "RTN","PSO HLDS2",128 ,0)
  1344   LENGTH(NT1 ) ; compen sate for l ength > 24 5
  1345   "RTN","PSO HLDS2",129 ,0)
  1346    I $L(NT1) >245 S LTH =$E($L(NT1 )/245,1) S :$L(NT1)#2 45>0 LTH=L TH+1 F WW= 1:1:LTH D
  1347   "RTN","PSO HLDS2",130 ,0)
  1348    . S:WW=1  ST=1,EN=24 5 S:WW>1 S T=(ST+245) ,EN=(EN+24 5) S NT11= $E(NT1,ST, EN)
  1349   "RTN","PSO HLDS2",131 ,0)
  1350    . S:WW=1  ^TMP("PSO" ,$J,PSI)=N T11 S:WW>1  ^TMP("PSO ",$J,PSI,W W-1)=NT11
  1351   "RTN","PSO HLDS2",132 ,0)
  1352    S:'$D(LTH ) ^TMP("PS O",$J,PSI) =NT1 S PSI =PSI+1
  1353   "RTN","PSO HLDS2",133 ,0)
  1354    Q
  1355   "RTN","PSO HLDS2",134 ,0)
  1356   NTE2(PSI)  ; Patient  Narrative
  1357   "RTN","PSO HLDS2",135 ,0)
  1358    K ^UTILIT Y($J,"W")  S (DIWL,PS NACNT)=1,D IWR=45,DIW F="",(PSSI XFL,PSSEVF L)=0 F ZZ= 0:0 S ZZ=$ O(^PS(59,P SOSITE,6,Z Z)) Q:'ZZ   I $D(^(ZZ ,0)) S X=^ (0) D ^DIW P
  1359   "RTN","PSO HLDS2",136 ,0)
  1360    F LLL=0:0  S LLL=$O( ^UTILITY($ J,"W",DIWL ,LLL)) Q:' LLL  S ^TM P("PSO",$J ,PSI,PSNAC NT)=^UTILI TY($J,"W", DIWL,LLL,0 ) S PSNACN T=PSNACNT+ 1,PSSIXFL= 1
  1361   "RTN","PSO HLDS2",137 ,0)
  1362    I PSSIXFL  S ^TMP("P SO",$J,PSI )="NTE"_FS _2_FS_FS,^ TMP("PSO", $J,PSI,PSN ACNT)=" "  S PSNACNT= PSNACNT+1, FLDX=1
  1363   "RTN","PSO HLDS2",138 ,0)
  1364    S DIWL=1, DIWR=45,DI WF="" K ^U TILITY($J, "W") F ZZ= 0:0 S ZZ=$ O(^PS(59,P SOSITE,7,Z Z)) Q:'ZZ   I $D(^(ZZ ,0)) S X=^ (0) D ^DIW P
  1365   "RTN","PSO HLDS2",139 ,0)
  1366    F LLL=0:0  S LLL=$O( ^UTILITY($ J,"W",DIWL ,LLL)) Q:' LLL  S ^TM P("PSO",$J ,PSI,PSNAC NT)=^UTILI TY($J,"W", DIWL,LLL,0 ) S PSNACN T=PSNACNT+ 1,PSSEVFL= 1
  1367   "RTN","PSO HLDS2",140 ,0)
  1368    I PSSEVFL  S ^TMP("P SO",$J,PSI ,PSNACNT)= " " S PSNA CNT=PSNACN T+1
  1369   "RTN","PSO HLDS2",141 ,0)
  1370    S DIWL=1, DIWR=45,DI WF="" K ^U TILITY($J, "W") F ZZ= 0:0 S ZZ=$ O(^PS(59,P SOSITE,4,Z Z)) Q:'ZZ   I $D(^(ZZ ,0)) S X=^ (0) D ^DIW P
  1371   "RTN","PSO HLDS2",142 ,0)
  1372    F LLL=0:0  S LLL=$O( ^UTILITY($ J,"W",DIWL ,LLL)) Q:' LLL  S ^TM P("PSO",$J ,PSI,PSNAC NT)=^UTILI TY($J,"W", DIWL,LLL,0 ) S PSNACN T=PSNACNT+ 1
  1373   "RTN","PSO HLDS2",143 ,0)
  1374    S:$D(FLDX ) ^TMP("PS O",$J,PSI, PSNACNT-1) =^TMP("PSO ",$J,PSI,P SNACNT-1)_ FS_"Patien t Narrativ e",PSI=PSI +1
  1375   "RTN","PSO HLDS2",144 ,0)
  1376    K DIWF,DI WL,DIWR,LL L,PSNACNT, PSSEVFL,PS SIXFL,ZZ
  1377   "RTN","PSO HLDS2",145 ,0)
  1378    Q
  1379   "RTN","PSO HLDS2",146 ,0)
  1380   NTE3(PSI)  ;Drug Warn ing Narrat ive
  1381   "RTN","PSO HLDS2",147 ,0)
  1382    N NTE3,J, TEXT,W,CNT ,PSSWSITE
  1383   "RTN","PSO HLDS2",148 ,0)
  1384    S WARN=$P ($G(^PSDRU G(IDGN,0)) ,"^",8)
  1385   "RTN","PSO HLDS2",149 ,0)
  1386    S PSSWSIT E=+$O(^PS( 59.7,0))
  1387   "RTN","PSO HLDS2",150 ,0)
  1388    I $P($G(^ PS(59.7,PS SWSITE,10) ),"^",11)= "N" D
  1389   "RTN","PSO HLDS2",151 ,0)
  1390    .S WARN=$ $DRUG^PSSW RNA(IDGN,D FN)
  1391   "RTN","PSO HLDS2",152 ,0)
  1392    I WARN=""  Q
  1393   "RTN","PSO HLDS2",153 ,0)
  1394    S NTE3="N TE"_FS_3_F S_FS,^TMP( "PSO",$J,P SI)=NTE3,C NT=1
  1395   "RTN","PSO HLDS2",154 ,0)
  1396    F J=1:1 S  W=$P(WARN ,",",J) Q: W=""  D
  1397   "RTN","PSO HLDS2",155 ,0)
  1398    . S:CNT>1  ^TMP("PSO ",$J,PSI,C NT-1)=^TMP ("PSO",$J, PSI,CNT-1) _"\.sp\"
  1399   "RTN","PSO HLDS2",156 ,0)
  1400    . S TEXT= $$WTEXT^PS SWRNA(W,$G (OLAN)) I  TEXT'="" S  FLDX=1 D
  1401   "RTN","PSO HLDS2",157 ,0)
  1402    . . I $L( TEXT)<245  S ^TMP("PS O",$J,PSI, CNT)=TEXT, CNT=CNT+1  Q
  1403   "RTN","PSO HLDS2",158 ,0)
  1404    . . N LTH ,ST,EN,TXT ,WW
  1405   "RTN","PSO HLDS2",159 ,0)
  1406    . . S LTH =$E($L(TEX T)/245,1)  S:$L(TEXT) #245>0 LTH =LTH+1
  1407   "RTN","PSO HLDS2",160 ,0)
  1408    . . F WW= 1:1:LTH D
  1409   "RTN","PSO HLDS2",161 ,0)
  1410    . . . S:W W=1 ST=1,E N=245 S:WW >1 ST=(ST+ 245),EN=(E N+245) S T XT=$E(TEXT ,ST,EN)
  1411   "RTN","PSO HLDS2",162 ,0)
  1412    . . . S ^ TMP("PSO", $J,PSI,CNT )=TXT,CNT= CNT+1
  1413   "RTN","PSO HLDS2",163 ,0)
  1414    I $G(FLDX ) D  S PSI =PSI+1
  1415   "RTN","PSO HLDS2",164 ,0)
  1416    . I $L(^T MP("PSO",$ J,PSI,CNT- 1)_FS_"Dru g Warning  Narrative" )<245 S ^T MP("PSO",$ J,PSI,CNT- 1)=$G(^TMP ("PSO",$J, PSI,CNT-1) )_FS_"Drug  Warning N arrative"
  1417   "RTN","PSO HLDS2",165 ,0)
  1418    . E  S ^T MP("PSO",$ J,PSI,CNT) =FS_"Drug  Warning Na rrative"
  1419   "RTN","PSO HLDS2",166 ,0)
  1420    Q
  1421   "RTN","PSO HLDS2",167 ,0)
  1422   NTE4(PSI)  ;Profile i nformation
  1423   "RTN","PSO HLDS2",168 ,0)
  1424    S PSODFN= DFN N NTE4
  1425   "RTN","PSO HLDS2",169 ,0)
  1426    I $P(PSOP AR,"^",8)  D START^PS OHLDS3
  1427   "RTN","PSO HLDS2",170 ,0)
  1428    S:$D(NTE4 ) PSI=PSI+ 1
  1429   "RTN","PSO HLDS2",171 ,0)
  1430    Q
  1431   "RTN","PSO HLDS2",172 ,0)
  1432   NTE5(PSI)  ;Drug Inte ractions
  1433   "RTN","PSO HLDS2",173 ,0)
  1434    N NTE5 D: $D(DRI) ST ART2^PSOHL DS3
  1435   "RTN","PSO HLDS2",174 ,0)
  1436    S:$D(NTE5 ) ^TMP("PS O",$J,PSI) =NTE5_FS_" Drug Inter actions",P SI=PSI+1
  1437   "RTN","PSO HLDS2",175 ,0)
  1438    Q
  1439   "RTN","PSO HLDS2",176 ,0)
  1440   NTE6(PSI)  ;Drug Alle rgy Indica tions
  1441   "RTN","PSO HLDS2",177 ,0)
  1442    N NTE6
  1443   "RTN","PSO HLDS2",178 ,0)
  1444    Q:'$G(DAW )
  1445   "RTN","PSO HLDS2",179 ,0)
  1446    D START3^ PSOHLDS3
  1447   "RTN","PSO HLDS2",180 ,0)
  1448    Q:NTE6=""
  1449   "RTN","PSO HLDS2",181 ,0)
  1450    S ^TMP("P SO",$J,PSI )=NTE6_FS_ "Drug Alle rgy Indica tions",PSI =PSI+1
  1451   "RTN","PSO HLDS2",182 ,0)
  1452    Q
  1453   "RTN","PSO HLDS2",183 ,0)
  1454   NTE9(PSI)  ;Privacy N otificatio n
  1455   "RTN","PSO HLDS2",184 ,0)
  1456    N NTE9,PS OLAN
  1457   "RTN","PSO HLDS2",185 ,0)
  1458    S NTE9="N TE"_FS_9_F S_FS,^TMP( "PSO",$J,P SI)=NTE9
  1459   "RTN","PSO HLDS2",186 ,0)
  1460    S PSOLAN= $P($G(^PS( 55,DFN,"LA N")),"^",2 )
  1461   "RTN","PSO HLDS2",187 ,0)
  1462    I PSOLAN' =2 D
  1463   "RTN","PSO HLDS2",188 ,0)
  1464    . S ^TMP( "PSO",$J,P SI,1)="The  VA Notice  of Privac y Practice s, IB 10-1 63, which  outlines y our privac y rights,  is availab le online  at http:// DNS . URL /Health/ o r you may  obtain a c opy by wri ting the V HA Privacy  Office (1 9F2),"
  1465   "RTN","PSO HLDS2",189 ,0)
  1466    . S ^TMP( "PSO",$J,P SI,2)="810  Vermont A venue NW,  Washington , DC 20420 ."_FS_"Pri vacy Notif ication"
  1467   "RTN","PSO HLDS2",190 ,0)
  1468    I PSOLAN= 2 D
  1469   "RTN","PSO HLDS2",191 ,0)
  1470    . S ^TMP( "PSO",$J,P SI,1)="La  Notificaci on relacio nada con l as Politic as de Priv acidad del  Departame nto de Asu ntos del V eterano, I B 10-163,  contiene l os detalle s acerca d e sus dere chos de pr ivacidad y  esta disp onsible el ectronicam ente"
  1471   "RTN","PSO HLDS2",192 ,0)
  1472    . S ^TMP( "PSO",$J,P SI,2)=" en  la siguie nte direcc ion: http: // DNS . URL /Health/.    Usted tamb ien puede  conseguir  una copia  escribiend o a la Ofi cina de Pr ivacidad d el Departa mento de A suntos de  Salud del  Veterano,  (19F2),"
  1473   "RTN","PSO HLDS2",193 ,0)
  1474    . S ^TMP( "PSO",$J,P SI,3)="810  Vermont A venue NW,  Washington , DC 20420 ."_FS_"Pri vacy Notif ication"
  1475   "RTN","PSO HLDS2",194 ,0)
  1476    S PSI=PSI +1
  1477   "RTN","PSO HLDS2",195 ,0)
  1478    Q
  1479   "RTN","PSO HLDS2",196 ,0)
  1480   ZZZ(PSI) ; ZZZ segmen t for HL7  hazardous  text ;*524
  1481   "RTN","PSO HLDS2",197 ,0)
  1482    N DRIEN,H AZD,HAZH,V AR
  1483   "RTN","PSO HLDS2",198 ,0)
  1484    S DRIEN=$ P(^PSRX(IR XN,0),"^", 6)
  1485   "RTN","PSO HLDS2",199 ,0)
  1486    S VAR=$$H AZ^PSSUTIL (DRIEN)
  1487   "RTN","PSO HLDS2",200 ,0)
  1488    S HAZH=$P (VAR,"^",1 )
  1489   "RTN","PSO HLDS2",201 ,0)
  1490    S HAZH=$S (HAZH:"Y", 1:"N")
  1491   "RTN","PSO HLDS2",202 ,0)
  1492    S HAZD=$P (VAR,"^",2 )
  1493   "RTN","PSO HLDS2",203 ,0)
  1494    S HAZD=$S (HAZD:"Y", 1:"N")
  1495   "RTN","PSO HLDS2",204 ,0)
  1496    S ^TMP("P SO",$J,PSI )="ZZZ"_FS _FS_FS_FS_ HAZH_FS_HA ZD
  1497   "RTN","PSO HLDS2",205 ,0)
  1498    S PSI=PSI +1
  1499   "RTN","PSO HLDS2",206 ,0)
  1500    Q
  1501   "RTN","PSO OREDT")
  1502   0^5^B83164 804
  1503   "RTN","PSO OREDT",1,0 )
  1504   PSOOREDT ; BIR/SAB -  Edit order s from bac kdoor ;5/8 /08 3:27pm
  1505   "RTN","PSO OREDT",2,0 )
  1506    ;;7.0;OUT PATIENT PH ARMACY;**4 ,20,27,37, 57,46,78,1 02,104,119 ,143,148,2 60,281,304 ,289,298,3 79,377,391 ,313,427,4 11,524**;D EC 1997;Bu ild 12
  1507   "RTN","PSO OREDT",3,0 )
  1508    ;External  reference  to ^PSDRU G( support ed by DBIA  221
  1509   "RTN","PSO OREDT",4,0 )
  1510    ;External  reference  to L^PSSL OCK suppor ted by DBI A 2789
  1511   "RTN","PSO OREDT",5,0 )
  1512    ;External  reference  to UL^PSS LOCK suppo rted by DB IA 2789
  1513   "RTN","PSO OREDT",6,0 )
  1514    ;External  reference  to PSOL^P SSLOCK sup ported by  DBIA 2789
  1515   "RTN","PSO OREDT",7,0 )
  1516    ;External  reference  to PSOUL^ PSSLOCK su pported by  DBIA 2789
  1517   "RTN","PSO OREDT",8,0 )
  1518    ;External  reference  to ^VA(20 0 supporte d by DBIA  10060
  1519   "RTN","PSO OREDT",9,0 )
  1520   SEL K PSOI SLKD,PSOLO KED S PSOP LCK=$$L^PS SLOCK(PSOD FN,0) I '$ G(PSOPLCK)  D LOCK^PS OORCPY D S VAL K PSOP LCK S VALM BCK="" Q
  1521   "RTN","PSO OREDT",10, 0)
  1522    K PSOPLCK  D PSOL^PS SLOCK($P(P SOLST(ORN) ,"^",2)) I  '$G(PSOMS G) D UL^PS SLOCK(+$G( PSODFN)) D  SVALO K P SOMSG S VA LMBCK="" Q
  1523   "RTN","PSO OREDT",11, 0)
  1524    K PSOMSG  S PSOLOKED =1
  1525   "RTN","PSO OREDT",12, 0)
  1526    N PSOHZ S  PSOHZ=0     ;reset h az alert d isplayed t o user *52 4
  1527   "RTN","PSO OREDT",13, 0)
  1528    S REF=0 S :$$LSTRFL^ PSOBPSU1($ P(PSOLST(O RN),"^",2) ) REF=1  ; *377
  1529   "RTN","PSO OREDT",14, 0)
  1530    K PSORX(" DFLG"),DIR ,DUOUT,DIR UT S DIR(" A")="Selec t fields b y number"
  1531   "RTN","PSO OREDT",15, 0)
  1532    S DIR(0)= "LO^1:"_$S ($$STATUS^ PSOBPSUT($ P(PSOLST(O RN),"^",2) )'="":21,$ G(REF):20, 1:19)
  1533   "RTN","PSO OREDT",16, 0)
  1534    D ^DIR I  $D(DIRUT)  K DIR,DIRU T,DTOUT S  VALMBCK=""  D UL K PS OLOKED Q
  1535   "RTN","PSO OREDT",17, 0)
  1536   EDTSEL N V ALMCNT K P SOISLKD,PS ORX("DFLG" ),PSOOIFLG ,PSOMRFLG, DIR,DIRUT, DTOUT,DTOU T,ZONE S P SOQUIT=0,( PSOEDIT,PS ORXED)=1 I  +Y S FST= Y D HLDHDR ^PSOLMUTL  D  G EX ;P SO LM SELE CT MENU pr otocol
  1537   "RTN","PSO OREDT",18, 0)
  1538    .I '$G(PS OLOKED) S  PSOPLCK=$$ L^PSSLOCK( PSODFN,0)  I '$G(PSOP LCK) D LOC K^PSOORCPY  D SVAL K  PSOPLCK S  VALMBCK="" ,(PSOISLKD ,PSODE)=1  Q
  1539   "RTN","PSO OREDT",19, 0)
  1540    .I '$G(PS OLOKED) K  PSOPLCK D  PSOL^PSSLO CK($P(PSOL ST(ORN),"^ ",2)) I '$ G(PSOMSG)  D UL^PSSLO CK(+$G(PSO DFN)) D SV ALO K PSOM SG S VALMB CK="",(PSO ISLKD,PSOD E)=1 Q
  1541   "RTN","PSO OREDT",20, 0)
  1542    .K PSOMSG ,PSOPLCK S  (NEWEDT,P SOLOKED)=1  D EDT
  1543   "RTN","PSO OREDT",21, 0)
  1544    E  S VALM BCK="",PSO DE=1
  1545   "RTN","PSO OREDT",22, 0)
  1546   EX I $G(PS OISLKD)!($ G(PSOQUIT) ) D UL K P SOISLKD G  EX2
  1547   "RTN","PSO OREDT",23, 0)
  1548    I '$G(PSO SIGFL),'$G (PSORXED(" DFLG")) D  UPDATE^PSO ORED6 D LO G^PSORXED, POST^PSORX ED G EX1
  1549   "RTN","PSO OREDT",24, 0)
  1550    I $G(PSOS IGFL)=1 D   Q:$G(PSOR X("FN"))
  1551   "RTN","PSO OREDT",25, 0)
  1552    .N PSOTMP
  1553   "RTN","PSO OREDT",26, 0)
  1554    .S PSOTMP =$G(PSOFRO M),PSOFROM ="NEW"
  1555   "RTN","PSO OREDT",27, 0)
  1556    .S VALMSG ="This cha nge will c reate a ne w prescrip tion!",NCP DPFLG=1
  1557   "RTN","PSO OREDT",28, 0)
  1558    .D EN^PSO ORED1(.PSO RXED)
  1559   "RTN","PSO OREDT",29, 0)
  1560    .I $G(PSO RX("FN"))  D  Q
  1561   "RTN","PSO OREDT",30, 0)
  1562    ..D ^PSOB UILD
  1563   "RTN","PSO OREDT",31, 0)
  1564    ..K QUIT, PSORX("DFL G"),FST,FL D,IEN,FLN, INCOM,PSOI ,PSODRUG,P SOEDIT
  1565   "RTN","PSO OREDT",32, 0)
  1566    ..K PSORE NW,PSOSIGF L,PSOOIFLG ,PSOMRFLG, PSODIR,CHK ,PSORX("SI G"),PSODE
  1567   "RTN","PSO OREDT",33, 0)
  1568    ..K PSOTR N,PSORX("E DIT"),PSOR XED("FLD") ,NEWEDT
  1569   "RTN","PSO OREDT",34, 0)
  1570    ..S ZZEDI T=1 D EOJ^ PSONEW K Z ZEDIT
  1571   "RTN","PSO OREDT",35, 0)
  1572    ..D UL K  PSOLOKED S  VALMBCK=" Q"
  1573   "RTN","PSO OREDT",36, 0)
  1574    .S PSOFRO M=PSOTMP I  PSOFROM=" " K PSOFRO M
  1575   "RTN","PSO OREDT",37, 0)
  1576    ;
  1577   "RTN","PSO OREDT",38, 0)
  1578   EX1 I '$G( PSODE)!('$ G(ZONE)) I  $G(PSOREN W("OIRXN") ) D EN^PSO HLSN1(PSOR ENW("OIRXN "),"XX","" ,"Order ed ited")
  1579   "RTN","PSO OREDT",39, 0)
  1580   QUIT D UL  K PSOLOKED  D ^PSOBUI LD,ACT^PSO ORNE2 D:+^ PSRX($P(PS OLST(ORN), "^",2),"ST A")=5 EN^P SOCMOPC($P (PSOLST(OR N),"^",2))
  1581   "RTN","PSO OREDT",40, 0)
  1582    K:'$O(^PS RX($P(PSOL ST(ORN),"^ ",2),1,0))  REF
  1583   "RTN","PSO OREDT",41, 0)
  1584   EX2 S VALM BCK=$S($G( PSOQUIT):" R",$G(PSOR X("FN")):" Q",$G(ZONE ):"Q",1:"R ")
  1585   "RTN","PSO OREDT",42, 0)
  1586    K PSORXED ,FST,FLD,I EN,FLN,INC OM,PSOI,PS ODRUG,PSOE DIT,PSOREN W,PSOSIGFL ,PSODIR,CH K,PSORX("S IG"),PSODE ,PSOTRN,PS ORX("DFLG" ),RFED,ZON E,PSORX("E DIT"),PSOO IFLG,PSOMR FLG,SIG,QU IT,PSOQUIT
  1587   "RTN","PSO OREDT",43, 0)
  1588    K NEWEDT  I $G(VALMB CK)="R" W  ! D CLEAN^ PSOVER1 H  2
  1589   "RTN","PSO OREDT",44, 0)
  1590    Q
  1591   "RTN","PSO OREDT",45, 0)
  1592    ;
  1593   "RTN","PSO OREDT",46, 0)
  1594   EDT ; Rx E dit (Backd oor)
  1595   "RTN","PSO OREDT",47, 0)
  1596    K NCPDPFL G,PSOPKI,D EA
  1597   "RTN","PSO OREDT",48, 0)
  1598    S I=0 F   S I=$O(^PS RX($P(PSOL ST(ORN),"^ ",2),1,I))  Q:'I  S P SORXED("RX 1")=^PSRX( $P(PSOLST( ORN),"^",2 ),1,I,0)
  1599   "RTN","PSO OREDT",49, 0)
  1600    ;*298 Tra ck PI and  Oth Lang P I
  1601   "RTN","PSO OREDT",50, 0)
  1602    S (RX0,PS ORXED("RX0 "))=^PSRX( $P(PSOLST( ORN),"^",2 ),0),PSORX ED("RX2")= $G(^(2)),P SORXED("RX 3")=$G(^(3 )),PSOSIG= $P(^("SIG" ),"^"),PSO PINS=$G(^( "INS")),PS OOINS=$G(^ ("INSS"))
  1603   "RTN","PSO OREDT",51, 0)
  1604    I '$D(PSO DRUG) NEW  PSOY S PSO Y=$P(RX0,U ,6),PSOY(0 )=^PSDRUG( PSOY,0) D  SET^PSODRG  ; *298 mo ved this l ine from E DT+2  RX0  was not de fined yet
  1605   "RTN","PSO OREDT",52, 0)
  1606    F FLD=1:1 :$L(FST,", ") Q:$P(FS T,",",FLD) ']""!($G(P SORXED("DF LG")))!($G (PSORX("DF LG")))  S  FLN=+$P(FS T,",",FLD)  D
  1607   "RTN","PSO OREDT",53, 0)
  1608    .S PSORXE D("DFLG")= 0,(DA,PSOR XED("IRXN" ),PSORENW( "OIRXN"))= $P(PSOLST( ORN),"^",2 ),RX0=^PSR X(PSORXED( "IRXN"),0) ,PSOPKI=$P ($G(^PSRX( PSORXED("I RXN"),"PKI ")),"^") S :$G(PSOSIG )="" PSOSI G=$P(^("SI G"),"^")
  1609   "RTN","PSO OREDT",54, 0)
  1610    .;*298 Tr ack PI and  Oth Lang  PI
  1611   "RTN","PSO OREDT",55, 0)
  1612    .S:$G(PSO PINS)="" P SOPINS=$G( ^PSRX(DA," INS")) S:$ G(PSOOINS) ="" PSOOIN S=$G(^PSRX (DA,"INSS" ))
  1613   "RTN","PSO OREDT",56, 0)
  1614    .I '$G(PS OSIGFL) D
  1615   "RTN","PSO OREDT",57, 0)
  1616    ..S PSOI= +^PSRX(DA, "OR1"),PSO DAYS=$P(RX 0,"^",8),P SORXST=+$P ($G(^PS(53 ,$P(RX0,"^ ",3),0))," ^",7)
  1617   "RTN","PSO OREDT",58, 0)
  1618    ..I 'PSOI  S PSOI=+^ PSDRUG($P( RX0,"^",6) ,2),$P(^PS RX(DA,"OR1 "),"^")=PS OI
  1619   "RTN","PSO OREDT",59, 0)
  1620    ..S:'$G(P SODRUG("IE N")) PSODR UG("IEN")= $P(RX0,"^" ,6),PSODRU G("NAME")= $P(^PSDRUG ($P(RX0,"^ ",6),0),"^ ")
  1621   "RTN","PSO OREDT",60, 0)
  1622    ..S PSODR UG("OI")=P SOI
  1623   "RTN","PSO OREDT",61, 0)
  1624    .S PSORX( "PROVIDER" )=$P(RX0," ^",4),PSOR X("PROVIDE R NAME")=$ P(^VA(200, $P(RX0,"^" ,4),0),"^" ),PSOTRN=$ G(^PSRX(DA ,"TN"))
  1625   "RTN","PSO OREDT",62, 0)
  1626    .D:'$G(CH K) POP^PSO SIGNO(DA), CHK Q:$G(P SORXED("DF LG"))
  1627   "RTN","PSO OREDT",63, 0)
  1628    .S FDR="3 9.2^"_$S($ P(PSOPAR," ^",3):"6", 1:"")_";6. 5^113^114^ 3^1^22R^24 ^8^7^9^4^1 1;"_$S($P( RX0,"^",11 )="W"&($P( PSOPAR,"^" ,12)):"35; ",1:"")_"^ 10.6^5^20^ 23^12^PSOC OU^RF^81"
  1629   "RTN","PSO OREDT",64, 0)
  1630    .; Titrat ion/Mainte nance Rx c heck
  1631   "RTN","PSO OREDT",65, 0)
  1632    .I $$REQF LDS(FST),$ $TITRX^PSO UTL($P(PSO LST(ORN)," ^",2))="t"  D  S PSOR XED("DFLG" )=1 Q
  1633   "RTN","PSO OREDT",66, 0)
  1634    .. S VALM SG="Cannot  edit Drug /Dose fiel ds (Titrat ion Rx).", VALMBCK="R " W $C(7)
  1635   "RTN","PSO OREDT",67, 0)
  1636    .D:'$G(CH K) POP^PSO SIGNO(DA), CHK Q:$G(P SORXED("DF LG"))
  1637   "RTN","PSO OREDT",68, 0)
  1638    .S FDR="3 9.2^"_$S($ P(PSOPAR," ^",3):"6", 1:"")_";6. 5^113^114^ 3^1^22R^24 ^8^7^9^4^1 1;"_$S($P( RX0,"^",11 )="W"&($P( PSOPAR,"^" ,12)):"35; ",1:"")_"^ 10.6^5^20^ 23^12^PSOC OU^RF^81"
  1639   "RTN","PSO OREDT",69, 0)
  1640    .I $G(ST) =11!($G(ST )=12)!($G( ST)=14)!($ G(ST)=15)  D NDCDAWDE ^PSOORED7( ST,FLN,$G( RXN)) Q
  1641   "RTN","PSO OREDT",70, 0)
  1642    .S REF=0  S:$$LSTRFL ^PSOBPSU1( $P(PSOLST( ORN),"^",2 )) REF=1   ;*377
  1643   "RTN","PSO OREDT",71, 0)
  1644    .I FLN=20 ,'$G(REF)  S VALMSG=" There is n o Refill D ata to be  edited." Q
  1645   "RTN","PSO OREDT",72, 0)
  1646    .S DR=$P( FDR,"^",FL N) I DR="R F" D REF^P SOORED2 Q
  1647   "RTN","PSO OREDT",73, 0)
  1648    .I DR="PS OCOU" D PS OCOU^PSOOR ED6 Q
  1649   "RTN","PSO OREDT",74, 0)
  1650    .; Allow  edit of th e NDC when  the EDIT  DRUG setti ng is off
  1651   "RTN","PSO OREDT",75, 0)
  1652    .; Other  checks reg arding if  the NDC ma y be edite d are foun d in NDC^P SODRG - PS O*7*427
  1653   "RTN","PSO OREDT",76, 0)
  1654    .I FLN=2, '$P(PSOPAR ,"^",3) D   Q
  1655   "RTN","PSO OREDT",77, 0)
  1656    ..N NDC D  NDC^PSODR G(RXN,0,,. NDC) I $G( NDC)="^"!( $G(NDC)="" ) Q
  1657   "RTN","PSO OREDT",78, 0)
  1658    ..S (PSOD RUG("NDC") ,PSORXED(" FLD",27))= NDC
  1659   "RTN","PSO OREDT",79, 0)
  1660    .I FLN'>2 ,'$P(PSOPA R,"^",3) S  VALMSG="C heck site  parameters , Drug dat a is not e ditable."  Q
  1661   "RTN","PSO OREDT",80, 0)
  1662    .I FLN=3  D EDTDOSE^ PSOORED2,F ULL^VALM1, POST^PSODR G S:$G(PSO RX("DFLG") ) PSOISLKD =1,PSORX(" FN")=1 Q
  1663   "RTN","PSO OREDT",81, 0)
  1664    .I FLN=4  D INS^PSOO RED1 Q
  1665   "RTN","PSO OREDT",82, 0)
  1666    .I FLN=1  D PSOI^PSO ORED6 N PS OX S PSORX ED=1,PSOX( "IRXN")=$S ($D(DA):DA ,$D(PSORXE D("IRXN")) :PSORXED(" IRXN"),$D( PSORENW("O IRXN")):PS ORENW("OIR XN")) D:'$ G(PSORXED( "DFLG")) E N^PSODIAG  Q
  1667   "RTN","PSO OREDT",83, 0)
  1668    .I FLN=2  D DRG^PSOO RED6 N PSO X S PSORXE D=1,PSOX(" IRXN")=PSO RXED("IRXN ") D:'$G(P SORXED("DF LG")) EN^P SODIAG S:$ O(^PSRX(PS ORXED("IRX N"),1,0))  REF=1 Q
  1669   "RTN","PSO OREDT",84, 0)
  1670    .I FLN=12 ,PSOPKI W  !!,"Digita lly Signed  Order - P rovider ca n't be cha nged" D PA USE Q
  1671   "RTN","PSO OREDT",85, 0)
  1672    .I FLN=12  D PROV Q
  1673   "RTN","PSO OREDT",86, 0)
  1674    .I FLN=6  D ISDT^PSO ORED2 Q
  1675   "RTN","PSO OREDT",87, 0)
  1676    .I FLN=7  D FLDT^PSO ORED2 Q
  1677   "RTN","PSO OREDT",88, 0)
  1678    .I FLN=21 ,$$STATUS^ PSOBPSUT(R XN,0)="" S  VALMSG="I nvalid sel ection!" Q
  1679   "RTN","PSO OREDT",89, 0)
  1680    .I FLN=21  D  Q
  1681   "RTN","PSO OREDT",90, 0)
  1682    ..N DAW D  EDTDAW^PS ODAWUT(RXN ,0,.DAW) I  $G(DAW)=" ^" Q
  1683   "RTN","PSO OREDT",91, 0)
  1684    ..S (PSOD RUG("DAW") ,PSORXED(" FLD",81))= DAW
  1685   "RTN","PSO OREDT",92, 0)
  1686    .I FLN=9! (FLN=10)!( FLN=11) D  NOCHG^PSOO RED7 Q
  1687   "RTN","PSO OREDT",93, 0)
  1688    .S DR=+DR
  1689   "RTN","PSO OREDT",94, 0)
  1690    .K DIR,DI RUT,DIROUT  ;S DIE=52  D ^DIE I  $D(Y) S PS ORXED("DFL G")=1
  1691   "RTN","PSO OREDT",95, 0)
  1692    .K DIC,DI Q S DIC=52 ,DA=PSORXE D("IRXN"), DIQ="PSORX ED" D EN^D IQ1 K DIC, DIQ
  1693   "RTN","PSO OREDT",96, 0)
  1694    .S DIR("B ")=$S($G(P SORXED("FL D",DR))]"" :PSORXED(" FLD",DR),1 :PSORXED(5 2,DA,DR)), DIR(0)="52 ,"_DR D ^D IR
  1695   "RTN","PSO OREDT",97, 0)
  1696    .I DR=24! (DR=12) S  PSORXED("F LD",DR)=X
  1697   "RTN","PSO OREDT",98, 0)
  1698    .I $D(DIR UT) K DIR, DIRUT,DUOU T,DTOUT,PS ORXED(52,D A,DR),PSOR XED("FLD", DR) Q
  1699   "RTN","PSO OREDT",99, 0)
  1700    .I DR'=5, X="@" W !, "Data Requ ired!",! K  DIC,DIQ,D R,DA,DIR,D IRUT,PSORX ED(52,DA,D R),X,Y Q
  1701   "RTN","PSO OREDT",100 ,0)
  1702    .I DR=5,X '="@" S Y= +Y
  1703   "RTN","PSO OREDT",101 ,0)
  1704    .I DR=3!( DR=20)!(DR =23) S Y=+ Y
  1705   "RTN","PSO OREDT",102 ,0)
  1706    .S PSORXE D("FLD",DR )=$S(X="@" :X,1:Y) K  DIR,DIRUT, DIROUT,X,Y ,PSORXED(5 2,DA,DR)
  1707   "RTN","PSO OREDT",103 ,0)
  1708    .I DR=11, PSORXED("F LD",DR)="W ",$P(PSOPA R,"^",12)  D
  1709   "RTN","PSO OREDT",104 ,0)
  1710    ..D FIELD ^DID(52,DR ,"","LABEL ","ZZ") S  PSORXED(ZZ ("LABEL")) =PSORXED(" FLD",DR) K  ZZ
  1711   "RTN","PSO OREDT",105 ,0)
  1712    ..S DR=35 ,DIQ="PSOR XED" D EN^ DIQ1 K DIC ,DIQ,DIRUT ,DUOUT,DTO UT
  1713   "RTN","PSO OREDT",106 ,0)
  1714    ..S:$G(PS ORXED(52,D A,DR))]""  DIR("B")=P SORXED(52, DA,DR)
  1715   "RTN","PSO OREDT",107 ,0)
  1716    ..S DIR(0 )="52,"_(D R) D ^DIR  I $D(DIRUT ),X'="@" K  DIR,DIRUT  Q
  1717   "RTN","PSO OREDT",108 ,0)
  1718    ..S PSORX ED("FLD",D R)=X K DIR ,DIRUT,DIR OUT,X,Y,PS ORXED(52,D A,DR)
  1719   "RTN","PSO OREDT",109 ,0)
  1720    .I $G(PSO RXED("FLD" ,DR))]"" D  FIELD^DID (52,DR,"", "LABEL","Z Z") S PSOR XED(ZZ("LA BEL"))=PSO RXED("FLD" ,DR) K ZZ
  1721   "RTN","PSO OREDT",110 ,0)
  1722    Q:$G(PSOS IGFL)
  1723   "RTN","PSO OREDT",111 ,0)
  1724    S (RX1,I, RFD,RFDT)= 0 F  S I=$ O(^PSRX(PS ORXED("IRX N"),1,I))  Q:'I  S RF D=I,RFDT=$ P(^PSRX(PS ORXED("IRX N"),1,I,0) ,"^"),RX1( I)=$G(RX1( I))+1
  1725   "RTN","PSO OREDT",112 ,0)
  1726    Q
  1727   "RTN","PSO OREDT",113 ,0)
  1728   CHK S CHK= 1 I $G(^PS DRUG($P(PS ORXED("RX0 "),"^",6), "I"))]"",^ ("I")<DT S  VALMSG="T his drug h as been in activated.  ",PSORXED ("DFLG")=1  Q
  1729   "RTN","PSO OREDT",114 ,0)
  1730    K PSPOP I  $G(PSODIV ),$P(PSORX ED("RX2"), "^",9)'=PS OSITE S PS PRXN=PSORX ED("IRXN")  D  Q:PSOR XED("DFLG" )
  1731   "RTN","PSO OREDT",115 ,0)
  1732    .I '$P(PS OSYS,"^",2 ) S VALMSG ="RX# "_$P (^PSRX(PSP RXN,0),"^" )_" is not  a valid c hoice. (Di fferent Di vision)" S  PSORXED(" DFLG")=1 Q
  1733   "RTN","PSO OREDT",116 ,0)
  1734    .I $P(PSO SYS,"^",3)  K DIR,DUO UT,DTOUT D   K DIR,DU OUT,DTOUT  Q
  1735   "RTN","PSO OREDT",117 ,0)
  1736    ..W $C(7)  S DIR("A" ,1)="",DIR ("A",2)="R X# "_$P(^P SRX(PSPRXN ,0),"^")_"  is from a nother div ision.",DI R("A")="Co ntinue: (Y /N)",DIR(0 )="Y",DIR( "?",1)="'Y ' FOR YES" ,DIR("?")= "'N' FOR N O"
  1737   "RTN","PSO OREDT",118 ,0)
  1738    ..S DIR(" B")="N" D  ^DIR I 'Y! ($D(DIRUT) ) S PSORXE D("DFLG")= 1 W !
  1739   "RTN","PSO OREDT",119 ,0)
  1740    ;
  1741   "RTN","PSO OREDT",120 ,0)
  1742    I $P(^PSR X(PSORXED( "IRXN"),"S TA"),"^")= 16 D  Q
  1743   "RTN","PSO OREDT",121 ,0)
  1744    . S PSORX ED("DFLG") =1 S VALMS G="Prescri ptions on  Provider H old cannot  be edited ."
  1745   "RTN","PSO OREDT",122 ,0)
  1746    ;
  1747   "RTN","PSO OREDT",123 ,0)
  1748   CHKX K PSP OP,DIR,DTO UT,DUOUT,Y ,X Q
  1749   "RTN","PSO OREDT",124 ,0)
  1750    Q
  1751   "RTN","PSO OREDT",125 ,0)
  1752   PROV ;sele ct provide r
  1753   "RTN","PSO OREDT",126 ,0)
  1754    S PSORXED ("PROVIDER ")=$P(RX0, "^",4),PSO RXED("PROV IDER NAME" )=$P(^VA(2 00,$P(RX0, "^",4),0), "^")
  1755   "RTN","PSO OREDT",127 ,0)
  1756    D PROV^PS ODIR(.PSOR XED) I PSO RXED("PROV IDER")'=$P (RX0,"^",4 ) D
  1757   "RTN","PSO OREDT",128 ,0)
  1758    .K DIR,DI RUT W ! S  DIR(0)="Y" ,DIR("A",1 )="You hav e changed  the name o f the prov ider enter ed for thi s Rx."
  1759   "RTN","PSO OREDT",129 ,0)
  1760    .S DIR("A ",2)="This  edit will  cause the  provider' s name to  be update  for all fi lls.",DIR( "A")="Do y ou want to  continue"  D ^DIR
  1761   "RTN","PSO OREDT",130 ,0)
  1762    .I 'Y!$D( DIRUT) K P SORX("PROV IDER"),PSO RX("PROVID ER NAME"), PSORX("COS IGNING PRO VIDER") Q
  1763   "RTN","PSO OREDT",131 ,0)
  1764    .S PSORXE D("FLD",4) =PSORXED(" PROVIDER")  K DIR,DIR UT,DUOUT
  1765   "RTN","PSO OREDT",132 ,0)
  1766    .S PSORXE D("FLD",10 9)=$G(PSOR XED("COSIG NING PROVI DER"))
  1767   "RTN","PSO OREDT",133 ,0)
  1768    Q
  1769   "RTN","PSO OREDT",134 ,0)
  1770   UDPROV ;up date provi der
  1771   "RTN","PSO OREDT",135 ,0)
  1772    S $P(^PSR X(PSORXED( "IRXN"),0) ,"^",4)=PS ORXED("PRO VIDER"),$P (^(3),"^", 3)=$G(PSOR X("COSIGNI NG PROVIDE R"))
  1773   "RTN","PSO OREDT",136 ,0)
  1774    F XTY="1" ,"P" F I=0 :0 S I=$O( ^PSRX(PSOR XED("IRXN" ),XTY,I))  Q:'I  S $P (^PSRX(PSO RXED("IRXN "),XTY,I,0 ),"^",17)= PSORXED("P ROVIDER")  S:XTY RFED =I
  1775   "RTN","PSO OREDT",137 ,0)
  1776    K XTY,I
  1777   "RTN","PSO OREDT",138 ,0)
  1778    Q
  1779   "RTN","PSO OREDT",139 ,0)
  1780   SIG ;edit  medication  instructi ons (SIG)
  1781   "RTN","PSO OREDT",140 ,0)
  1782    S PSOFDR= +$P(^PSRX( PSORXED("I RXN"),"SIG "),"^",2)  I PSOFDR D
  1783   "RTN","PSO OREDT",141 ,0)
  1784    .F I=0:0  S I=$O(^PS RX(PSORXED ("IRXN")," SIG1",I))  Q:'I  S SI G(I)=^PSRX (PSORXED(" IRXN"),"SI G1",I,0)
  1785   "RTN","PSO OREDT",142 ,0)
  1786    E  S PSOR X("SIG")=$ P(^PSRX(PS ORXED("IRX N"),"SIG") ,"^")
  1787   "RTN","PSO OREDT",143 ,0)
  1788    D SIG^PSO DIR1(.PSOR X) D:$G(PS ORX("SIG") )]"" EN1^P SOSIGNO(PS ORXED("IRX N"),PSORX( "SIG"))
  1789   "RTN","PSO OREDT",144 ,0)
  1790    I '$G(PSO SIGFL),$G( PSORX("SIG "))]"" S ^ PSRX(PSORX ED("IRXN") ,"SIG")=PS ORX("SIG")  K ^PSRX(P SORXED("IR XN"),"SIG1 ") Q
  1791   "RTN","PSO OREDT",145 ,0)
  1792    S PSOMRFL G=1
  1793   "RTN","PSO OREDT",146 ,0)
  1794    Q
  1795   "RTN","PSO OREDT",147 ,0)
  1796   UL ;
  1797   "RTN","PSO OREDT",148 ,0)
  1798    I '$G(PSO LOKED) Q
  1799   "RTN","PSO OREDT",149 ,0)
  1800    D UL^PSSL OCK(PSODFN )
  1801   "RTN","PSO OREDT",150 ,0)
  1802    D PSOUL^P SSLOCK($P( PSOLST(ORN ),"^",2))
  1803   "RTN","PSO OREDT",151 ,0)
  1804    Q
  1805   "RTN","PSO OREDT",152 ,0)
  1806   SVAL ;Set  message fo r patient  lock
  1807   "RTN","PSO OREDT",153 ,0)
  1808    S VALMSG= $S($P($G(P SOPLCK),"^ ",2)'="":$ P($G(PSOPL CK),"^",2) _" is work ing on thi s patient. ",1:"Anoth er person  is enterin g orders f or this pa tient.")
  1809   "RTN","PSO OREDT",154 ,0)
  1810    Q
  1811   "RTN","PSO OREDT",155 ,0)
  1812   SVALO ;Set  message f or order l ock
  1813   "RTN","PSO OREDT",156 ,0)
  1814    S VALMSG= $S($P($G(P SOMSG),"^" ,2)'="":$P ($G(PSOMSG ),"^",2),1 :"Another  person is  editing th is order." )
  1815   "RTN","PSO OREDT",157 ,0)
  1816    Q
  1817   "RTN","PSO OREDT",158 ,0)
  1818    ;
  1819   "RTN","PSO OREDT",159 ,0)
  1820   PAUSE      ;
  1821   "RTN","PSO OREDT",160 ,0)
  1822    N DIR,X,Y
  1823   "RTN","PSO OREDT",161 ,0)
  1824    W ! S DIR (0)="E",DI R("A")="Pr ess Return  to contin ue" D ^DIR
  1825   "RTN","PSO OREDT",162 ,0)
  1826    Q
  1827   "RTN","PSO OREDT",163 ,0)
  1828   REQFLDS(FI ELDS) ; Ch ecks if fi elds 1,2 o r 3 are be ing edited
  1829   "RTN","PSO OREDT",164 ,0)
  1830    N REQFLDS ,I
  1831   "RTN","PSO OREDT",165 ,0)
  1832    S REQFLDS =0
  1833   "RTN","PSO OREDT",166 ,0)
  1834    F I=1:1:$ L(FIELDS)  I ",1,2,3, "[(","_+$P (FIELDS,", ",I)_",")  S REQFLDS= 1 Q
  1835   "RTN","PSO OREDT",167 ,0)
  1836    Q REQFLDS
  1837   "RTN","PSO ORNE2")
  1838   0^6^B11480 7367
  1839   "RTN","PSO ORNE2",1,0 )
  1840   PSOORNE2 ; BIR/SAB -  Display fi nished ord ers from b ackdoor ;7 /15/16 2:3 0pm
  1841   "RTN","PSO ORNE2",2,0 )
  1842    ;;7.0;OUT PATIENT PH ARMACY;**1 1,21,23,27 ,32,37,46, 84,103,117 ,131,146,1 56,210,148 ,222,238,2 64,281,289 ,251,379,3 91,313,282 ,427,454,4 46,467,524 **;DEC 199 7;Build 12
  1843   "RTN","PSO ORNE2",3,0 )
  1844    ;
  1845   "RTN","PSO ORNE2",4,0 )
  1846    ;^PSDRUG(  -  221
  1847   "RTN","PSO ORNE2",5,0 )
  1848    ;^YSCL(60 3.01 - 269 7
  1849   "RTN","PSO ORNE2",6,0 )
  1850    ;^PS(50.6 06 - 2174
  1851   "RTN","PSO ORNE2",7,0 )
  1852    ;^PS(50.7  - 2223
  1853   "RTN","PSO ORNE2",8,0 )
  1854    ;PSO*210  add call t o WORDWRAP  api
  1855   "RTN","PSO ORNE2",9,0 )
  1856    ;$$DAWEXT ^PSSDAWUT  - 4708
  1857   "RTN","PSO ORNE2",10, 0)
  1858    ;
  1859   "RTN","PSO ORNE2",11, 0)
  1860    ;*524 cre ate and in it psohz;  user has s een Haz dr ug warning  during th is order's  session
  1861   "RTN","PSO ORNE2",12, 0)
  1862    ;*530 pre vent parti al fills ( PR)
  1863   "RTN","PSO ORNE2",13, 0)
  1864    ;
  1865   "RTN","PSO ORNE2",14, 0)
  1866   SEL N ORN, ORD,PSORRB LD I '$G(P SOCNT),'$G (PSORCNT)  S VALMSG=" This patie nt has no  Prescripti ons!" S VA LMBCK="" Q
  1867   "RTN","PSO ORNE2",15, 0)
  1868    D K1^PSOO RNE6 S DIR ("A")="Sel ect Orders  by number ",DIR(0)=" LO^1:"_$S( $G(PSORCNT ):PSORCNT, 1:PSOCNT)  D ^DIR I $ D(DIRUT) D  KV^PSOVER 1 S VALMBC K="" Q
  1869   "RTN","PSO ORNE2",16, 0)
  1870   NEWSEL N O RN,ORD D K 2^PSOORNE6
  1871   "RTN","PSO ORNE2",17, 0)
  1872    N PSOHZ,P SOLSTDR S  (PSOHZ,PSO LSTDR)=0   ;reset haz  alerts di splayed to  user *524
  1873   "RTN","PSO ORNE2",18, 0)
  1874    ;*282 Cor rect Patie nt Instruc tions Copy
  1875   "RTN","PSO ORNE2",19, 0)
  1876    I +Y S PS OOELSE=1,P SLST=Y K P SOREEDT F  ORD=1:1:$L (PSLST,"," ) Q:$P(PSL ST,",",ORD )']""  D   D UL1 K ^T MP("PSORXP O",$J),PSO RXED,PSONE W,PSOPINS  I $G(PSOQU IT) K PSOQ UIT Q
  1877   "RTN","PSO ORNE2",20, 0)
  1878    .; bwf 1/ 21/2014 -  replaced l ine below  with the o ne that fo llows for  remote rx  data handl ing.
  1879   "RTN","PSO ORNE2",21, 0)
  1880    .;S ORN=+ $P(PSLST," ,",ORD) D  @$S(+PSOLS T(ORN)=52: "ACT",1:"P EN^PSOORNE 5")
  1881   "RTN","PSO ORNE2",22, 0)
  1882    .S ORN=+$ P(PSLST,", ",ORD) D @ $S(+PSOLST (ORN)=52:" ACT",$P(PS OLST(ORN), "^")="R52" :"RACT",1: "PEN^PSOOR NE5")
  1883   "RTN","PSO ORNE2",23, 0)
  1884    .K PSOREE DT,PSOSIGF L,PSONACT, SIGOK,PSOF DR,DRET,SI G,INS1
  1885   "RTN","PSO ORNE2",24, 0)
  1886    K PRC,PHI ,RTE I '$G (PSOOELSE)  S VALMBCK =""
  1887   "RTN","PSO ORNE2",25, 0)
  1888    K PSONACT ,PSOOELSE, CLOZPAT
  1889   "RTN","PSO ORNE2",26, 0)
  1890    ;
  1891   "RTN","PSO ORNE2",27, 0)
  1892    ; Only re build remo te if some thing chan ged
  1893   "RTN","PSO ORNE2",28, 0)
  1894    I $G(PSOR RBLD) W !! ,"Updating  prescript ion order  list...",! ! D REMOTE RX^PSORRX1 (PSODFN,PS OSITE) K P SORRBLD
  1895   "RTN","PSO ORNE2",29, 0)
  1896    ;
  1897   "RTN","PSO ORNE2",30, 0)
  1898    D ^PSOBUI LD,BLD^PSO ORUT1,K3^P SOORNE6
  1899   "RTN","PSO ORNE2",31, 0)
  1900    Q
  1901   "RTN","PSO ORNE2",32, 0)
  1902    ;
  1903   "RTN","PSO ORNE2",33, 0)
  1904   ACT N REF, RPHKEY,PKI ND K ^TMP( "PSOAO",$J ),PCOMX,PD A,PHI,PRC, ACOM,ANS,P SOFDR,CLOZ PAT,ANQREM ,DUR,DRET
  1905   "RTN","PSO ORNE2",34, 0)
  1906    S RXN=$P( PSOLST(ORN ),"^",2),R X0=^PSRX(R XN,0),RX2= $G(^(2)),R X3=$G(^(3) ),ST=+$G(^ ("STA")),R XOR=$G(^(" OR1")),POE =$G(^("POE ")),EXDT=$ S($P($G(^( 2)),"^",6) >DT:1,1:0)
  1907   "RTN","PSO ORNE2",35, 0)
  1908    I 'RX3 S  $P(RX3,"^" ,1)=$P(RX2 ,"^",2),$P (^PSRX(RXN ,3),"^")=$ P(RX2,"^", 2)
  1909   "RTN","PSO ORNE2",36, 0)
  1910    S PSODRG= +$P(RX0,"^ ",6),PSODR UG0=^PSDRU G(PSODRG,0 ),INDT=$G( ^("I"))
  1911   "RTN","PSO ORNE2",37, 0)
  1912    ;PSO*7*23 8;SET PSOD RUG ARRAY  ; PSOY KIL LED AT END  OF SET^PS ODRG
  1913   "RTN","PSO ORNE2",38, 0)
  1914    K PSODRUG
  1915   "RTN","PSO ORNE2",39, 0)
  1916    S PSOY=PS ODRG,PSOY( 0)=PSODRUG 0 D SET^PS ODRG
  1917   "RTN","PSO ORNE2",40, 0)
  1918    I 'RXOR,$ P(^PSDRUG( PSODRG,2), "^") S $P( ^PSRX(RXN, "OR1"),"^" )=$P(^PSDR UG(PSODRG, 2),"^"),RX OR=$P(^PSD RUG(PSODRG ,2),"^")
  1919   "RTN","PSO ORNE2",41, 0)
  1920    I $P($G(^ PSDRUG(PSO DRG,"CLOZ1 ")),"^")=" PSOCLO1" D
  1921   "RTN","PSO ORNE2",42, 0)
  1922    .S CLOZPA T=$O(^YSCL (603.01,"C ",PSODFN,0 )) Q:'CLOZ PAT
  1923   "RTN","PSO ORNE2",43, 0)
  1924    .;S CLOZP AT=$S($P(^ YSCL(603.0 1,CLOZPAT, 0),"^",3)= "B":1,1:0)
  1925   "RTN","PSO ORNE2",44, 0)
  1926    .S CLOZPA T=$P(^YSCL (603.01,CL OZPAT,0)," ^",3)
  1927   "RTN","PSO ORNE2",45, 0)
  1928    .S CLOZPA T=$S(CLOZP AT="M":2,C LOZPAT="B" :1,1:0)
  1929   "RTN","PSO ORNE2",46, 0)
  1930    S PKIND=$ D(^PSRX(RX N,"PKI")), RPHKEY=$S( 'PKIND&($D (^XUSEC("P SORPH",DUZ ))):1,PKIN D&($D(^XUS EC("PSDRPH ",DUZ))):1 ,1:0)
  1931   "RTN","PSO ORNE2",47, 0)
  1932    I RPHKEY  S RPH=1 D
  1933   "RTN","PSO ORNE2",48, 0)
  1934    .S PSOACT =$S('ST&($ G(INDT)]"" )&(DT>$G(I NDT)):"DHP LATC",ST=1 !(ST=4):"D VE",ST=3:" DU",ST=5:" ELTD",ST=1 1:"ETDPCL" ,ST=12&EXD T:"EDCL",S T=12&'EXDT :"ECL",(ST =14!(ST=15 ))&'EXDT:" ECL",ST=13 :"L",ST=16 :"DL",1:"D HPEATCL")
  1935   "RTN","PSO ORNE2",49, 0)
  1936    .D GET^PS OORNE5 S P SOACT=PSOA CT_$S(ACTR EN:"N",1:" "),PSOACT= PSOACT_$S( ACTREF:"R" ,1:"")
  1937   "RTN","PSO ORNE2",50, 0)
  1938    .I ST=5 S  SURX=$O(^ PS(52.5,"B ",RXN,0))  I SURX,$P( $G(^PS(52. 5,SURX,0)) ,"^",7)="L " S PSOACT ="TL" K SU RX Q
  1939   "RTN","PSO ORNE2",51, 0)
  1940    .S:ST'=12 &('$D(^PS( 50.7,+$P(R XOR,"^"),0 ))) PSOACT ="DL",VALM SG="No Pha rmacy Orde rable Item  !",PSONAC T=1
  1941   "RTN","PSO ORNE2",52, 0)
  1942    .S:ST=12& ('$D(^PS(5 0.7,+$P(RX OR,"^"),0) )) PSOACT= "L",VALMSG ="No Pharm acy Ordera ble Item ! ",PSONACT= 1
  1943   "RTN","PSO ORNE2",53, 0)
  1944    .S:ST=16  VALMSG="Rx  Placed on  HOLD by P rovider."
  1945   "RTN","PSO ORNE2",54, 0)
  1946    E  D
  1947   "RTN","PSO ORNE2",55, 0)
  1948    .I ST=5 S  SURX=$O(^ PS(52.5,"B ",RXN,0))  I SURX,$P( $G(^PS(52. 5,SURX,0)) ,"^",7)="L " S PSOACT ="TL" Q
  1949   "RTN","PSO ORNE2",56, 0)
  1950    .S PSOACT =$S(ST'<1& (ST'>4)!(S T>12):"",S T=12&EXDT& ($P($G(PSO PAR),"^",2 )):"CDPLT" ,1:"CPLT")
  1951   "RTN","PSO ORNE2",57, 0)
  1952    .D GET^PS OORNE5 S P SOACT=PSOA CT_$S(ACTR EN:"N",1:" "),PSOACT= PSOACT_$S( ACTREF:"R" ,1:"")
  1953   "RTN","PSO ORNE2",58, 0)
  1954    .S:'$D(^P S(50.7,+$P (RXOR,"^") ,0)) PSOAC T="L",PSON ACT=1,VALM SG="No Pha rmacy Orde rable Item  !"
  1955   "RTN","PSO ORNE2",59, 0)
  1956    ;K PSOLKF L D PSOL^P SSLOCK(RXN ) I '$G(PS OMSG) K PS OMSG S PSO LKFL=1 S P SOACT="",V ALMSG="Thi s Order is  being edi ted by ano ther user. "
  1957   "RTN","PSO ORNE2",60, 0)
  1958    K PSOMSG  S IEN=0,$P (RN," ",12 )=" "
  1959   "RTN","PSO ORNE2",61, 0)
  1960    D DIN^PSO NFI(+RXOR, $P(RX0,"^" ,6))
  1961   "RTN","PSO ORNE2",62, 0)
  1962    ; pso*7*4 67 - add d isplay of  erx inform ation if t he rx came  from eRx
  1963   "RTN","PSO ORNE2",63, 0)
  1964    N ERXIEN
  1965   "RTN","PSO ORNE2",64, 0)
  1966    I $P(RXOR ,U,2)]"" D
  1967   "RTN","PSO ORNE2",65, 0)
  1968    .S ERXIEN =$$CHKERX^ PSOERXU1($ P(RXOR,U,2 )) I ERXIE N D DERX1^ PSOERXU1($ NA(^TMP("P SOAO",$J)) ,ERXIEN,"" ,.IEN)
  1969   "RTN","PSO ORNE2",66, 0)
  1970    ; pso*7*4 67 - end e Rx enhance ment
  1971   "RTN","PSO ORNE2",67, 0)
  1972    S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)=$S($ P($G(^PSRX (RXN,"TPB" )),"^"):"              TPB Rx #:  ",1:"                  Rx #: ")
  1973   "RTN","PSO ORNE2",68, 0)
  1974    S ^TMP("P SOAO",$J,I EN,0)=^TMP ("PSOAO",$ J,IEN,0)_$ P(RX0,"^") _$S($G(^PS RX(RXN,"IB ")):"$",1: "")_$$ECME ^PSOBPSUT( RXN)_$$TIT RX^PSOUTL( RXN)_$E(RN ,$L($P(RX0 ,"^")_$S($ G(^PSRX(RX N,"IB")):" $",1:"")_$ $ECME^PSOB PSUT(RXN)_ $$TITRX^PS OUTL(RXN)) +1,12)
  1975   "RTN","PSO ORNE2",69, 0)
  1976    S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)=" (" _$S($P(PSO PAR,"^",3) :1,1:"#")_ ")"_" *Ord erable Ite m: "_$S($D (^PS(50.7, $P(+RXOR," ^"),0)):$P (^PS(50.7, $P(+RXOR," ^"),0),"^" )_" "_$P(^ PS(50.606, $P(^(0),"^ ",2),0),"^ "),1:"")_N FIO
  1977   "RTN","PSO ORNE2",70, 0)
  1978    S:NFIO["< DIN>" NFIO =IEN_","_( $L(^TMP("P SOAO",$J,I EN,0))-4)
  1979   "RTN","PSO ORNE2",71, 0)
  1980    S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)=" (" _$S($P(PSO PAR,"^",3) :2,1:"#")_ ")"_$S($D( ^PSDRUG("A Q",$P(RX0, "^",6))):"        CMO P ",1:"             " )_"Drug: " _$P(^PSDRU G($P(RX0," ^",6),0)," ^")_NFID
  1981   "RTN","PSO ORNE2",72, 0)
  1982    S:NFID["< DIN>" NFID =IEN_","_( $L(^TMP("P SOAO",$J,I EN,0))-4)
  1983   "RTN","PSO ORNE2",73, 0)
  1984    S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)=" "_ $S('$P(PSO PAR,"^",3) :"(2)",1:"    ")_"               NDC: "_$$G ETNDC^PSON DCUT(RXN,0 )
  1985   "RTN","PSO ORNE2",74, 0)
  1986    S:$G(^PSR X(RXN,"TN" ))]"" IEN= IEN+1,^TMP ("PSOAO",$ J,IEN,0)="            Trade Name : "_$G(^PS RX(RXN,"TN "))
  1987   "RTN","PSO ORNE2",75, 0)
  1988    D DOSE^PS OORNE5
  1989   "RTN","PSO ORNE2",76, 0)
  1990    S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)=" (4 )Pat Instr uctions:"  D INS^PSOO RNE5
  1991   "RTN","PSO ORNE2",77, 0)
  1992    D PC^PSOO RNE5
  1993   "RTN","PSO ORNE2",78, 0)
  1994    S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="                   SIG:"
  1995   "RTN","PSO ORNE2",79, 0)
  1996    I '$P($G( ^PSRX(RXN, "SIG")),"^ ",2) S SIG OK=0 D  G  PTST
  1997   "RTN","PSO ORNE2",80, 0)
  1998    .S X=$P($ G(^PSRX(RX N,"SIG")), "^") D SIG ONE^PSOHEL P S SIG=$E ($G(INS1), 2,250)
  1999   "RTN","PSO ORNE2",81, 0)
  2000    .F SG=1:1 :$L(SIG) S :$L(^TMP(" PSOAO",$J, IEN,0)_" " _$P(SIG,"  ",SG))>80  IEN=IEN+1, $P(^TMP("P SOAO",$J,I EN,0)," ", 21)=" " S: $P(SIG," " ,SG)'="" ^ TMP("PSOAO ",$J,IEN,0 )=$G(^TMP( "PSOAO",$J ,IEN,0))_"  "_$P(SIG, " ",SG)
  2001   "RTN","PSO ORNE2",82, 0)
  2002    S SIGOK=1
  2003   "RTN","PSO ORNE2",83, 0)
  2004    F I=0:0 S  I=$O(^PSR X(RXN,"SIG 1",I)) Q:' I  D                    ;PSO*210
  2005   "RTN","PSO ORNE2",84, 0)
  2006    . S MIG=$ P(^PSRX(RX N,"SIG1",I ,0),"^")
  2007   "RTN","PSO ORNE2",85, 0)
  2008    . D WORDW RAP^PSOUTL A2(MIG,.IE N,$NA(^TMP ("PSOAO",$ J)),21)
  2009   "RTN","PSO ORNE2",86, 0)
  2010    S SIGOK=1  K MIG,SG
  2011   "RTN","PSO ORNE2",87, 0)
  2012   PTST S $P( RN," ",25) =" ",PTST= $S($G(^PS( 53,+$P(RX0 ,"^",3),0) )]"":$P($G (^PS(53,+$ P(RX0,"^", 3),0)),"^" ),1:""),IE N=IEN+1
  2013   "RTN","PSO ORNE2",88, 0)
  2014    S ^TMP("P SOAO",$J,I EN,0)=" (5 )  Patient  Status: " _PTST_$E(R N,$L(PTST) +1,25)
  2015   "RTN","PSO ORNE2",89, 0)
  2016    S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)=" (6 )      Iss ue Date: " _$E($P(RX0 ,"^",13),4 ,5)_"/"_$E ($P(RX0,"^ ",13),6,7) _"/"_$E($P (RX0,"^",1 3),2,3)
  2017   "RTN","PSO ORNE2",90, 0)
  2018    S ^TMP("P SOAO",$J,I EN,0)=^TMP ("PSOAO",$ J,IEN,0)_"                 (7)   Fill Date:  "_$E($P(R X2,"^",2), 4,5)_"/"_$ E($P(RX2," ^",2),6,7) _"/"_$E($P (RX2,"^",2 ),2,3)
  2019   "RTN","PSO ORNE2",91, 0)
  2020    S ROU=$S( $P(RX0,"^" ,11)="W":" Window",1: "Mail")
  2021   "RTN","PSO ORNE2",92, 0)
  2022    S REFL=$P (RX0,"^",9 ),I=0 F  S  I=$O(^PSR X(RXN,1,I) ) Q:'I  S  REFL=REFL- 1,ROU=$S($ P(^PSRX(RX N,1,I,0)," ^",2)="W": "Window",1 :"Mail")
  2023   "RTN","PSO ORNE2",93, 0)
  2024    S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="       Last Fi ll Date: " _$E($P(RX3 ,"^"),4,5) _"/"_$E($P (RX3,"^"), 6,7)_"/"_$ E($P(RX3," ^"),2,3)
  2025   "RTN","PSO ORNE2",94, 0)
  2026    D CMOP^PS OORNE3
  2027   "RTN","PSO ORNE2",95, 0)
  2028    S ^TMP("P SOAO",$J,I EN,0)=^TMP ("PSOAO",$ J,IEN,0)_"  ("_ROU_$S ($G(PSOCMO P)]"":", " _PSOCMOP,1 :"")_")" K  ROU,PSOCM OP
  2029   "RTN","PSO ORNE2",96, 0)
  2030    ;*282 Cor rect retur n to stock /release d isplay
  2031   "RTN","PSO ORNE2",97, 0)
  2032    S IEN=IEN +1 D
  2033   "RTN","PSO ORNE2",98, 0)
  2034    .S RLD=$S ($P(RX2,"^ ",13):$E($ P(RX2,"^", 13),4,5)_" /"_$E($P(R X2,"^",13) ,6,7)_"/"_ $E($P(RX2, "^",13),2, 3),1:"")
  2035   "RTN","PSO ORNE2",99, 0)
  2036    .I $O(^PS RX(RXN,1,0 )) F I=0:0  S I=$O(^P SRX(RXN,1, I)) Q:'I   D
  2037   "RTN","PSO ORNE2",100 ,0)
  2038    ..I $P(^P SRX(RXN,1, I,0),"^",1 8) S RLD=$ E($P(^(0), "^",18),4, 5)_"/"_$E( $P(^(0),"^ ",18),6,7) _"/"_$E($P (^(0),"^", 18),2,3)
  2039   "RTN","PSO ORNE2",101 ,0)
  2040    .I $P(RX2 ,"^",15)&' $G(RLD) S  ^TMP("PSOA O",$J,IEN, 0)="   Ret urned to S tock: "_$E ($P(RX2,"^ ",15),4,5) _"/"_$E($P (RX2,"^",1 5),6,7)_"/ "_$E($P(RX 2,"^",15), 2,3)_$S($P (RX2,"^",1 4):" (Repr inted)",1: "")
  2041   "RTN","PSO ORNE2",102 ,0)
  2042    .E  S ^TM P("PSOAO", $J,IEN,0)= "   Last R elease Dat e: "_$S($G (RLD)]"":R LD,1:"         ")
  2043   "RTN","PSO ORNE2",103 ,0)
  2044    S ^TMP("P SOAO",$J,I EN,0)=^TMP ("PSOAO",$ J,IEN,0)_"                 (8)       Lot #:  "_$P($G(R X2),"^",4)
  2045   "RTN","PSO ORNE2",104 ,0)
  2046    S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="               Expires: " _$E($P(RX2 ,"^",6),4, 5)_"/"_$E( $P(RX2,"^" ,6),6,7)_" /"_$E($P(R X2,"^",6), 2,3)
  2047   "RTN","PSO ORNE2",105 ,0)
  2048    S ^TMP("P SOAO",$J,I EN,0)=^TMP ("PSOAO",$ J,IEN,0)_"                             MFG:  "_$P($G(R X2),"^",8)
  2049   "RTN","PSO ORNE2",106 ,0)
  2050    S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="(9)       Days  Supply: " _$P(RX0,"^ ",8)_$S($L ($P(RX0,"^ ",8))=1:"  ",1:"")
  2051   "RTN","PSO ORNE2",107 ,0)
  2052    S ^TMP("P SOAO",$J,I EN,0)=^TMP ("PSOAO",$ J,IEN,0)_"                       (10)  QTY" _$S($P($G( ^PSDRUG($P (RX0,"^",6 ),660)),"^ ",8)]"":"  ("_$P($G(^ PSDRUG($P( RX0,"^",6) ,660)),"^" ,8)_")",1: " (  )")_" : "_$P(RX0 ,"^",7)
  2053   "RTN","PSO ORNE2",108 ,0)
  2054    I $P($G(^ PSDRUG($P( RX0,"^",6) ,5)),"^")] "" D
  2055   "RTN","PSO ORNE2",109 ,0)
  2056    .S $P(RN, " ",79)="  ",IEN=IEN+ 1
  2057   "RTN","PSO ORNE2",110 ,0)
  2058    .S ^TMP(" PSOAO",$J, IEN,0)=$E( RN,$L("QTY  DSP MSG:  "_$P(^PSDR UG($P(RX0, "^",6),5), "^"))+1,79 )_"QTY DSP  MSG: "_$P (^PSDRUG($ P(RX0,"^", 6),5),"^")  K RN
  2059   "RTN","PSO ORNE2",111 ,0)
  2060    S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="(11 )    # of  Refills: " _$P(RX0,"^ ",9)_$S($L ($P(RX0,"^ ",9))=1:"  ",1:"")_"                             Remai ning: "_RE FL
  2061   "RTN","PSO ORNE2",112 ,0)
  2062    S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="(12 )        P rovider: " _$S($D(^VA (200,$P(RX 0,"^",4),0 )):$P(^VA( 200,$P(RX0 ,"^",4),0) ,"^"),1:"U NKNOWN")
  2063   "RTN","PSO ORNE2",113 ,0)
  2064    I +$P($G( ^PSDRUG($P (RX0,"^",6 ),0)),"^", 3)>1,+$P($ G(^PSDRUG( $P(RX0,"^" ,6),0)),"^ ",3)<6 D P RV^PSOORNE 5
  2065   "RTN","PSO ORNE2",114 ,0)
  2066    I $P(RX3, "^",3) S I EN=IEN+1,^ TMP("PSOAO ",$J,IEN,0 )="         Cos-Provi der: "_$P( ^VA(200,$S ($G(PSORX( "COSIGNING  PROVIDER" )):PSORX(" COSIGNING  PROVIDER") ,1:$P(RX3, "^",3)),0) ,"^")
  2067   "RTN","PSO ORNE2",115 ,0)
  2068    S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="(13 )          Routing: " _$S($P(RX0 ,"^",11)=" M":"MAIL", 1:"WINDOW" )_"                    (14)      Copies: "_ $S($P(RX0, "^",18):$P (RX0,"^",1 8),1:1)
  2069   "RTN","PSO ORNE2",116 ,0)
  2070    S:$P(RX0, "^",11)="W "&($P(PSOP AR,"^",12) ) IEN=IEN+ 1,^TMP("PS OAO",$J,IE N,0)="     Method of  Pickup: "_ $G(^PSRX(R XN,"MP"))
  2071   "RTN","PSO ORNE2",117 ,0)
  2072    S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="(15 )           Clinic: " _$S($D(^SC (+$P(RX0," ^",5),0)): $P(^SC($P( RX0,"^",5) ,0),"^"),1 :"Not on F ile")
  2073   "RTN","PSO ORNE2",118 ,0)
  2074    S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="(16 )        D ivision: " _$S($G(^PS (59,+$P(RX 2,"^",9),0 ))]"":$P(^ PS(59,$P(R X2,"^",9), 0),"^")_"  ("_$P(^(0) ,"^",6)_") ",1:"UNKNO WN")
  2075   "RTN","PSO ORNE2",119 ,0)
  2076    S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="(17 )      Pha rmacist: " _$S($P(RX2 ,"^",3):$P (^VA(200,$ P(RX2,"^", 3),0),"^") ,1:"")
  2077   "RTN","PSO ORNE2",120 ,0)
  2078    S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="(18 )          Remarks:"  D RMK^PSOO RNE3
  2079   "RTN","PSO ORNE2",121 ,0)
  2080    S IEN=IEN +1,^TMP("P SOAO",$J,I EN,0)="(19 )      Cou nseling: " _$S($P($G( ^PSRX(RXN, "PC")),"^" ):"YES",1: "NO")_"                        " _$S($P($G( ^PSRX(RXN, "PC")),"^" ):"Was Cou nseling Un derstood:  "_$S($P($G (^PSRX(RXN ,"PC")),"^ ",2):"YES" ,1:"NO"),1 :"")
  2081   "RTN","PSO ORNE2",122 ,0)
  2082    S:$O(^PSR X(RXN,1,0) ) REF=1,IE N=IEN+1,^T MP("PSOAO" ,$J,IEN,0) ="(20)      Refill Da ta"
  2083   "RTN","PSO ORNE2",123 ,0)
  2084    I $$STATU S^PSOBPSUT (RXN,0)'=" " D
  2085   "RTN","PSO ORNE2",124 ,0)
  2086    . N DAW S  IEN=IEN+1 ,DAW=$$GET DAW^PSODAW UT(RXN,0)
  2087   "RTN","PSO ORNE2",125 ,0)
  2088    . S ^TMP( "PSOAO",$J ,IEN,0)="( 21)         DAW Code:  "_DAW_" -  "_$$DAWEX T^PSSDAWUT (DAW)
  2089   "RTN","PSO ORNE2",126 ,0)
  2090    D DISP^PS OORNE6
  2091   "RTN","PSO ORNE2",127 ,0)
  2092    I $G(PSOB EDT),PSOAC T["E" S PS OACT="E"
  2093   "RTN","PSO ORNE2",128 ,0)
  2094    I $G(PSOB EDT),PSOAC T'["E" S P SOACT=""
  2095   "RTN","PSO ORNE2",129 ,0)
  2096    Q:$G(PSOR XED)!($G(C OPY))!($G( UPMI))
  2097   "RTN","PSO ORNE2",130 ,0)
  2098    S:$G(PSOB EDT) (PSOE DIT,PSORXE D)=1
  2099   "RTN","PSO ORNE2",131 ,0)
  2100   RENERR S P SORERR=0 D  ^PSOLMLST
  2101   "RTN","PSO ORNE2",132 ,0)
  2102    I PSORERR =1 S:$G(PS OBEDT) (PS OEDIT,PSOR XED)=1 G R ENERR
  2103   "RTN","PSO ORNE2",133 ,0)
  2104    K DRET,SI G
  2105   "RTN","PSO ORNE2",134 ,0)
  2106    Q
  2107   "RTN","PSO ORNE2",135 ,0)
  2108   UL1 ;
  2109   "RTN","PSO ORNE2",136 ,0)
  2110    Q
  2111   "RTN","PSO ORNE2",137 ,0)
  2112    ; bwf 1/2 1/2014 - a dding disp lay of rem ote active  orders.
  2113   "RTN","PSO ORNE2",138 ,0)
  2114   RACT ; dis play remot e active o rder
  2115   "RTN","PSO ORNE2",139 ,0)
  2116    N REMSITE ,CNT,REMDA TA,RSITENM ,RRXNUM,RD ETSTR,RSIG STR,RDET,R SIG,REMSIE N,RXSTAT,S IGLOOP,DET LOOP,DONE, SRXSTAT,SD NAME,DNAME
  2117   "RTN","PSO ORNE2",140 ,0)
  2118    K ^TMP("P SOAO",$J)
  2119   "RTN","PSO ORNE2",141 ,0)
  2120    S (RSIG,R DET)=""
  2121   "RTN","PSO ORNE2",142 ,0)
  2122    S REMSITE =$P(PSOLST (ORN),U,4)  Q:'REMSIT E
  2123   "RTN","PSO ORNE2",143 ,0)
  2124    S REMSIEN =$O(^DIC(4 ,"D",REMSI TE,""))
  2125   "RTN","PSO ORNE2",144 ,0)
  2126    S REMSIEN =$$FIND1^D IC(4,,"X", REMSITE,"D ","I $P(^( 0),U,11)=" "N"",'$P($ G(^(99)),U ,4)") Q:'R EMSIEN
  2127   "RTN","PSO ORNE2",145 ,0)
  2128    S RSITENM =$$GET1^DI Q(4,REMSIE N,.01,"E")
  2129   "RTN","PSO ORNE2",146 ,0)
  2130    ; do not  continue i f we are m issing the  remote or der number  for some  reason
  2131   "RTN","PSO ORNE2",147 ,0)
  2132    S RRXNUM= $P(PSOLST( ORN),U,2)  Q:'RRXNUM
  2133   "RTN","PSO ORNE2",148 ,0)
  2134    S DONE=0
  2135   "RTN","PSO ORNE2",149 ,0)
  2136    S RXSTAT= "" F  S RX STAT=$O(^X TMP("PSORR X1",$J,PSO DFN,REMSIT E,RXSTAT))  Q:RXSTAT= ""!DONE  D
  2137   "RTN","PSO ORNE2",150 ,0)
  2138    .S SRXSTA T=RXSTAT
  2139   "RTN","PSO ORNE2",151 ,0)
  2140    .S DNAME= "" F  S DN AME=$O(^XT MP("PSORRX 1",$J,PSOD FN,REMSITE ,RXSTAT,DN AME)) Q:DN AME=""!DON E  D
  2141   "RTN","PSO ORNE2",152 ,0)
  2142    ..S SDNAM E=DNAME
  2143   "RTN","PSO ORNE2",153 ,0)
  2144    ..I $P(^X TMP("PSORR X1",$J,PSO DFN,REMSIT E,RXSTAT,D NAME,0),U, 1)=RRXNUM  S DONE=1 Q
  2145   "RTN","PSO ORNE2",154 ,0)
  2146    Q:$G(SRXS TAT)=""
  2147   "RTN","PSO ORNE2",155 ,0)
  2148    S REMDATA =$G(^XTMP( "PSORRX1", $J,PSODFN, REMSITE,SR XSTAT,SDNA ME,0))
  2149   "RTN","PSO ORNE2",156 ,0)
  2150    S RDETSTR =$G(^XTMP( "PSORRX1", $J,PSODFN, REMSITE,SR XSTAT,SDNA ME,"DETAIL "))
  2151   "RTN","PSO ORNE2",157 ,0)
  2152    S RSIGSTR =$G(^XTMP( "PSORRX1", $J,PSODFN, REMSITE,SR XSTAT,SDNA ME,"SIG"))
  2153   "RTN","PSO ORNE2",158 ,0)
  2154    S CNT=1
  2155   "RTN","PSO ORNE2",159 ,0)
  2156    S ^TMP("P SOAO",$J,C NT,0)="          Site  #: "_REMS ITE_"("_RS ITENM_")", CNT=CNT+1
  2157   "RTN","PSO ORNE2",160 ,0)
  2158    S ^TMP("P SOAO",$J,C NT,0)="            Rx  #: "_RRXN UM,CNT=CNT +1
  2159   "RTN","PSO ORNE2",161 ,0)
  2160    S ^TMP("P SOAO",$J,C NT,0)="       Drug Na me: "_$P(R EMDATA,U,1 1),CNT=CNT +1
  2161   "RTN","PSO ORNE2",162 ,0)
  2162    S ^TMP("P SOAO",$J,C NT,0)="     Days Supp ly: "_$S($ E($P(REMDA TA,U,4),1) ?1A:$E($P( REMDATA,U, 4),2,99),1 :$P(REMDAT A,U,4)),CN T=CNT+1
  2163   "RTN","PSO ORNE2",163 ,0)
  2164    S ^TMP("P SOAO",$J,C NT,0)="        Quanti ty: "_$P(R EMDATA,U,2 ),CNT=CNT+ 1
  2165   "RTN","PSO ORNE2",164 ,0)
  2166    S ^TMP("P SOAO",$J,C NT,0)="         Refil ls: "_$P(R EMDATA,U,3 ),CNT=CNT+ 1
  2167   "RTN","PSO ORNE2",165 ,0)
  2168    S ^TMP("P SOAO",$J,C NT,0)="Exp iration Da te: "_$$RD T($P($P(RE MDATA,U,5) ,".")),CNT =CNT+1
  2169   "RTN","PSO ORNE2",166 ,0)
  2170    S ^TMP("P SOAO",$J,C NT,0)="      Issue Da te: "_$$RD T($P($P(RE MDATA,U,6) ,".")),CNT =CNT+1
  2171   "RTN","PSO ORNE2",167 ,0)
  2172    S ^TMP("P SOAO",$J,C NT,0)="       Stop Da te: "_$$RD T($P($P(RE MDATA,U,7) ,".")),CNT =CNT+1
  2173   "RTN","PSO ORNE2",168 ,0)
  2174    S ^TMP("P SOAO",$J,C NT,0)=" La st Fill Da te: "_$$RD T($P($P(RE MDATA,U,8) ,".")),CNT =CNT+1
  2175   "RTN","PSO ORNE2",169 ,0)
  2176    ;D RCHUNK (.RDET,RDE TSTR),RCHU NK(.RSIG,R SIGSTR)
  2177   "RTN","PSO ORNE2",170 ,0)
  2178    ;S ^TMP(" PSOAO",$J, CNT,0)="          Det ail: "_$G( RDET(1)),C NT=CNT+1
  2179   "RTN","PSO ORNE2",171 ,0)
  2180    ;S DETLOO P=1 F  S D ETLOOP=$O( RDET(DETLO OP)) Q:'DE TLOOP  D
  2181   "RTN","PSO ORNE2",172 ,0)
  2182    ;.S ^TMP( "PSOAO",$J ,CNT,0)="                 "_RDET (DETLOOP), CNT=CNT+1
  2183   "RTN","PSO ORNE2",173 ,0)
  2184    D RCHUNK( .RSIG,RSIG STR)
  2185   "RTN","PSO ORNE2",174 ,0)
  2186    S ^TMP("P SOAO",$J,C NT,0)="             S ig: "_$G(R SIG(1))
  2187   "RTN","PSO ORNE2",175 ,0)
  2188    S SIGLOOP =1 F  S SI GLOOP=$O(R SIG(SIGLOO P)) Q:'SIG LOOP  D
  2189   "RTN","PSO ORNE2",176 ,0)
  2190    .S CNT=CN T+1,^TMP(" PSOAO",$J, CNT,0)="                 "_RSIG( SIGLOOP)
  2191   "RTN","PSO ORNE2",177 ,0)
  2192    ; ^PSOLML ST is the  local orde r template
  2193   "RTN","PSO ORNE2",178 ,0)
  2194    D EN^PSOR OS
  2195   "RTN","PSO ORNE2",179 ,0)
  2196    Q
  2197   "RTN","PSO ORNE2",180 ,0)
  2198   RCHUNK(ARR ,STR) ;
  2199   "RTN","PSO ORNE2",181 ,0)
  2200    N START,E ND,I,C,ROO M
  2201   "RTN","PSO ORNE2",182 ,0)
  2202    S ROOM=60
  2203   "RTN","PSO ORNE2",183 ,0)
  2204    ; if ther e is enoug h room for  1 line, n o wrapping  needed
  2205   "RTN","PSO ORNE2",184 ,0)
  2206    I $L(STR) '>ROOM S A RR(1)=STR  Q
  2207   "RTN","PSO ORNE2",185 ,0)
  2208    ; add a s pace to th e end of t he string  to avoid d ropping la st charact er
  2209   "RTN","PSO ORNE2",186 ,0)
  2210    S START=1 ,END=ROOM, STR=STR_"  "
  2211   "RTN","PSO ORNE2",187 ,0)
  2212    F C=1:1 D   Q:$L(STR )<START  ;  stop if w e have mad e it to th e end of t he data st ring
  2213   "RTN","PSO ORNE2",188 ,0)
  2214    .; start  at the end  and work  backwards  until you  find a bla nk space,  cut the li ne there a nd move on  to the ne xt line 
  2215   "RTN","PSO ORNE2",189 ,0)
  2216    .F I=END: -1:START I  $E(STR,I) =" " S ARR (C)=$E(STR ,START,I), START=I+1, END=ROOM+S TART Q
  2217   "RTN","PSO ORNE2",190 ,0)
  2218    .; make s ure there  wasn't a r eally long  string wi thout spac es
  2219   "RTN","PSO ORNE2",191 ,0)
  2220    .I I=STAR T S ARR(C) =$E(STR,ST ART,END),S TART=END+1 ,END=ROOM+ START
  2221   "RTN","PSO ORNE2",192 ,0)
  2222    Q
  2223   "RTN","PSO ORNE2",193 ,0)
  2224   RDT(DATE)  ;
  2225   "RTN","PSO ORNE2",194 ,0)
  2226    N Y,M,D
  2227   "RTN","PSO ORNE2",195 ,0)
  2228    S Y=$E(DA TE,3,4),M= $E(DATE,5, 6),D=$E(DA TE,7,8)
  2229   "RTN","PSO ORNE2",196 ,0)
  2230    Q M_"/"_D _"/"_Y
  2231   "VER")
  2232   8.0^22.2
  2233   **END**
  2234   **END**