PSOORFI1 ;BIR/SAB - finish OP orders from OE/RR continued ;Dec 13, 2021@08:00:50
;;7.0;OUTPATIENT PHARMACY;**7,15,23,27,32,44,51,46,71,90,108,131,152,186,210,222,258,260,225,391,408,444,467,505,617,441,651,700**;DEC 1997;Build 261
;Ref. ^PS(50.7 supp. DBIA 2223
;Ref. ^PSDRUG( supp. DBIA 221
;Ref. L^PSSLOCK supp. DBIA 2789
;Ref. ^PS(50.606 supp. DBIA 2174
;Ref. ^PS(55 supp. DBIA 2228
;Ref. ULK^ORX2 supp. DBIA 867
;Ref. ^SC( supp. DBIA 10040
;Ref. ^VA(200 supp. DBIA 10060
;Ref. ^XUSEC( supp. DBIA 10076
;Ref. ULK^ORX2 DBIA 867
;Ref. KVA^VADPT supp. DBIA 10061
;Ref. FULL^VALM1 supp. DBIA 10116
;
;PSO*186 add call to function $$DEACHK
;PSO*210 add call to WORDWRAP api
;
S SIGOK=1
DSPL K ^TMP("PSOPO",$J),CLOZPAT,PSOPRC,PSODSPL
S (OI,PSODRUG("OI"))=$P(OR0,"^",8),PSODRUG("OIN")=$P(^PS(50.7,$P(OR0,"^",8),0),"^"),OID=$P(OR0,"^",9)
I $P($G(OR0),"^",9) S POERR=1,DREN=$P(OR0,"^",9) D DRG^PSOORDRG K POERR G DRG
I '$P(OR0,"^",9) D DREN^PSOORNW2
DRG I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),"CLOZ1")),"^")="PSOCLO1" D CLOZ^PSOORFI2
;PSO*186 modify If/Else below to use DEACHK
I $G(PSODRUG("DEA"))]"" D
.S PSOCS=0 K DIR,DIC,PSOX
.N PSDEA,PSDAYS S PSDEA=PSODRUG("DEA"),PSDAYS=+$P(OR0,"^",22)
.I $$DEACHK^PSOUTLA1("*",PSDEA,PSDAYS,$G(CLOZPAT),.PSOCS,.PSOMAX)
E D
.S PSOMAX=$S($G(CLOZPAT)=2:3,$G(CLOZPAT)=1:1,1:$P(OR0,"^",11))
ISSDT S (PSOID,Y,PSONEW("ISSUE DATE"))=$S($G(PSONEW("ISSUE DATE")):PSONEW("ISSUE DATE"),$P($G(OR0),"^",6):$E($P(OR0,"^",6),1,7),1:DT)
X ^DD("DD") S PSONEW("ISSUE DATE")=Y
D USER^PSOORFI2($P(OR0,"^",4)) S PSONEW("CLERK CODE")=$P(OR0,"^",4),PSORX("CLERK CODE")=USER1
S (PSONEW("DFLG"),PSONEW("QFLG"))=0,PSODFN=$P(OR0,"^",2),PSONEW("QTY")=$P(OR0,"^",10),PSONEW("MAIL/WINDOW")=$S($P(OR0,"^",17)="M":"M",$P(OR0,"^",17)="P":"P",1:"W")
S:$G(PSONEW("CLINIC"))']"" PSONEW("CLINIC")=+$P(OR0,"^",13),PSORX("CLINIC")=$S($D(^SC(PSONEW("CLINIC"),0)):$P(^SC(PSONEW("CLINIC"),0),"^"),1:"")
S:$G(PSORX("CLINIC"))']"" PSORX("CLINIC")=$S($D(^SC(+$P(OR0,"^",13),0)):$P(^SC($P(OR0,"^",13),0),"^"),1:"")
D USER^PSOORFI2($P(OR0,"^",5))
S PSONEW("CLERK CODE")=$P(OR0,"^",4),PSONEW("PROVIDER")=$P(OR0,"^",5),PSONEW("PROVIDER NAME")=USER1
S PSONEW("PATIENT STATUS")=$S(+$G(^PS(55,PSODFN,"PS")):+$G(^PS(55,PSODFN,"PS")),1:"")
S PSONEW("CHCS NUMBER")=$S($P($G(^PS(52.41,+$G(ORD),"EXT")),"^")'="":$P($G(^("EXT")),"^"),1:"")
S PSONEW("EXTERNAL SYSTEM")=$S($P($G(^PS(52.41,+$G(ORD),"EXT")),"^",3)'="":$P($G(^("EXT")),"^",3),1:"")
I $P(OR0,"^",22)>0 S PSONEW("DAYS SUPPLY")=$P(OR0,"^",22) G DS
S PSONEW("DAYS SUPPLY")=$S(+$G(^PS(55,PSODFN,"PS"))&($P($G(^PS(53,+$G(^PS(55,PSODFN,"PS")),0)),"^",3)):$P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3),1:30)
DS ;
S:$D(CLOZPAT) PSONEW("DAYS SUPPLY")=$S(CLOZPAT=2&(PSONEW("DAYS SUPPLY")>28):28,CLOZPAT=1&(PSONEW("DAYS SUPPLY")>14):14,'CLOZPAT&(PSONEW("DAYS SUPPLY")>7):7,1:PSONEW("DAYS SUPPLY"))
S IEN=0 D OBX ; Display Order Checks Information
D LMDISP^PSOORFI5(+$G(ORD)) ; Display Flag/Unflag Information
D DIN^PSONFI(PSODRUG("OI"),$S($D(PSODRUG("IEN")):PSODRUG("IEN"),1:"")) ;Setup for N/F & DIN indicator
; pso*7*467 - add display of erx information if the rx came from eRx
N ERXIEN
S ERXIEN=$$CHKERX^PSOERXU1(OR0) I ERXIEN D DERX1^PSOERXU1($NA(^TMP("PSOPO",$J)),ERXIEN,"",.IEN,"P")
; pso*7*467 - end eRx enhancement
S:$P($G(^PS(52.41,ORD,4)),"^",2)]"" PSONEW("IND")=$P($G(^PS(52.41,ORD,4)),"^",2) ;*441-IND
S:$P($G(^PS(52.41,ORD,4)),"^",3)]"" PSONEW("INDO")=$P($G(^PS(52.41,ORD,4)),"^",3)
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="*(1) Orderable Item: "_$P(^PS(50.7,PSODRUG("OI"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")_NFIO
S:NFIO["<DIN>" NFIO=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4)
;
K LST I $G(PSODRUG("NAME"))]"" D G PST
.S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2)"_$S($D(^PSDRUG("AQ",PSODRUG("IEN"))):" CMOP ",1:" ")_"Drug: "_PSODRUG("NAME")_NFID
.S:NFID["<DIN>" NFID=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4)
.I $P(^PSDRUG(PSODRUG("IEN"),0),"^",10)]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Drug Message:" D DRGMSG^PSOORNEW
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2) Drug: No Dispense Drug Selected"
PST D DOSE^PSOORFI4 K PSOINSFL
S PSOINSFL=$P($G(^PS(52.41,ORD,"INS")),"^",2)
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (4) Pat Instruct:" D INST^PSOORFI4
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Provider Comments:" S TY=3 D INST
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Indications: "_$G(PSONEW("IND")) ;*441-IND
I $G(ERXIEN) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" eRx Drug: "_$$GET1^DIQ(52.49,ERXIEN,3.1)
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" "_$S($G(ERXIEN):"eRx",1:" ")_" Instructions: " S TY=2 D INST
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" SIG:" D SIG
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (5) Patient Status: "_$P($G(^PS(53,+PSONEW("PATIENT STATUS"),0)),"^")
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (6) Issue Date: "_PSONEW("ISSUE DATE")
S (Y,PSONEW("FILL DATE"))=$S($E($P(OR0,"^",6),1,7)<DT:DT,1:$E($P(OR0,"^",6),1,7)) X ^DD("DD") S PSORX("FILL DATE")=Y,^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" (7) Fill Date: "_Y
I $P(OR0,"^",18) D
.S IEN=IEN+1,Y=$P(OR0,"^",18) X ^DD("DD") S $P(^TMP("PSOPO",$J,IEN,0)," ",39)="Effective Date: "_Y
D:$D(CLOZPAT) ELIG^PSOORFI2,CLQTY^PSOORFI4
N PSDAYS,MAXRF
S PSDAYS=$S($G(PSONEW("DAYS SUPPLY")):PSONEW("DAYS SUPPLY"),+$G(^PS(55,PSODFN,"PS"))&($P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3)):$P(^PS(53,+$G(^PS(55,PSODFN,"PS")),0),"^",3),1:"")
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (8) Days Supply: "_PSDAYS
S RXPT=+$G(^PS(55,PSODFN,"PS"))
; Retrieving the Maximum Number of Refills allowed
S MAXRF=$$MAXNUMRF^PSOUTIL(+$G(PSODRUG("IEN")),PSDAYS,RXPT,.CLOZPAT)
S PSONEW("# OF REFILLS")=$S(+$P(OR0,"^",11)>MAXRF:MAXRF,1:+$P(OR0,"^",11))
KILL RXPT
;
S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_" (9) QTY"_$S($P($G(^PSDRUG(+$G(PSODRUG("IEN")),660)),"^",8)]"":" ("_$P($G(^PSDRUG(+$G(PSODRUG("IEN")),660)),"^",8)_")",1:" ( )")_": "_$G(PSONEW("QTY"))
I $P($G(^PSDRUG(+$G(PSODRUG("IEN")),5)),"^")]"" D
.S $P(RN," ",79)=" ",IEN=IEN+1
.S ^TMP("PSOPO",$J,IEN,0)=$E(RN,$L("QTY DSP MSG: "_$P(^PSDRUG(PSODRUG("IEN"),5),"^"))+1,79)_"QTY DSP MSG: "_$P(^PSDRUG(PSODRUG("IEN"),5),"^") K RN
S IEN=IEN+1
I $P(OR0,"^",24) S ^TMP("PSOPO",$J,IEN,0)=" Provider ordered: days supply "_$P(OR0,"^",22)_", quantity "_$P(OR0,"^",10)_" & refills "_+$P(OR0,"^",11)
E S ^TMP("PSOPO",$J,IEN,0)=" Provider ordered "_+$P(OR0,"^",11)_" refills"
D:$D(CLOZPAT) PQTY^PSOORFI4
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(10) # of Refills: "_PSONEW("# OF REFILLS")_$E(" ",$L(PSONEW("# OF REFILLS"))+1,2)_" (11) Routing: "_$S($G(PSONEW("MAIL/WINDOW"))="M":"MAIL",$G(PSONEW("MAIL/WINDOW"))="P":"PARK",1:"WINDOW")
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(12) Clinic: "_PSORX("CLINIC")
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(13) Provider: "_PSONEW("PROVIDER NAME")
I $G(PKI),+$G(PSODRUG("DEA"))>1,+$G(PSODRUG("DEA"))<6 D PRV^PSOORFI5($P(OR0,"^",5),$P(OR0,"^",9),$P(OR0,"^"))
I $P($G(^VA(200,$S($G(PSONEW("PROVIDER")):PSONEW("PROVIDER"),1:$P(OR0,"^",5)),"PS")),"^",7)&($P($G(^("PS")),"^",8)) S PSONEW("COSIGNING PROVIDER")=$P(^("PS"),"^",8) D
.D USER^PSOORFI2(PSONEW("COSIGNING PROVIDER"))
.S IEN=IEN+1 S ^TMP("PSOPO",$J,IEN,0)=" Cos-Provider: "_USER1
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(14) Copies: 1"
S PSONEW("REMARKS")=$S($P(OR0,"^",17)="C":"Administered in Clinic.",1:"")
K PSONEW("ADMINCLINIC") S:$P(OR0,"^",17)="C" PSONEW("ADMINCLINIC")=1
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(15) Remarks: "_$S($G(PSONEW("REMARKS"))]"":PSONEW("REMARKS"),1:"")
D USER^PSOORFI2($P(OR0,"^",4))
S $P(RN," ",35)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Entry By: "_USER1_$E(RN,$L(USER1)+1,35)
S Y=$P(OR0,"^",12) X ^DD("DD") S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_"Entry Date: "_$E($P(OR0,"^",12),4,5)_"/"_$E($P(OR0,"^",12),6,7)_"/"_$E($P(OR0,"^",12),2,3)_" "_$P(Y,"@",2) K RN
; DEA compliance note for eRx CS prescriptions
S ERXIEN=$$ERXIEN^PSOERXUT($G(ORD)_"P")
I ERXIEN,$$GET1^DIQ(52.49,ERXIEN,95.1,"I"),$$CS^PSOERXA0(+$$GET1^DIQ(52.49,ERXIEN,3.2,"I")) D
. S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=""
. S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="This prescription meets the requirements of the Drug Enforcement Administration"
. S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(DEA) electronic prescribing for controlled substances rules (21 CFR Parts 1300,"
. S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="1304, 1306, & 1311)."
I $P(OR0,"^",24) S PSOACT=$S($D(^XUSEC("PSDRPH",DUZ)):"DEFX",$D(^XUSEC("PSORPH",DUZ)):"F",$P($G(PSOPAR),"^",2):"F",1:"") D
.K PSOCSP S PSOCSP("NAME")=$G(PSODRUG("NAME")) M PSOCSP("DOSE")=PSONEW("DOSE"),PSOCSP("DOSE ORDERED")=PSONEW("DOSE ORDERED")
.S PSOCSP("# OF REFILLS")=PSONEW("# OF REFILLS") ;track original data for dig. orders
.S PSOCSP("ISSUE DATE")=$E($P(OR0,"^",6),1,7),PSOCSP("QTY")=PSONEW("QTY"),PSOCSP("DAYS SUPPLY")=PSONEW("DAYS SUPPLY")
E S PSOACT=$S($D(^XUSEC("PSORPH",DUZ)):"DEFX",'$D(^XUSEC("PSORPH",DUZ))&($P($G(PSOPAR),"^",2)):"F",1:"")
; - PSOACTOV is used to force the Pending Order to be Read-Only (no updates) even if invoked by a Pharmacist
I $G(PSOACTOV) S PSOACT=""
; eRx Pending Order (Side-By-Side) Interface (Replaces conventional interface above)
S ERXIEN=$$ERXIEN^PSOERXUT($G(ORD)_"P")
I ERXIEN D
. I $D(VALMEVL) F I=1:1:99 D RESTORE^VALM10(I)
. S (IEN,LINE)=0 K ^TMP("PSOPO",$J)
. D SETPEN^PSOERUT5("PSOPO",ERXIEN,+ORD,.PSONEW,.PSODRUG,,0) S (VALMCNT,IEN)=LINE-1
. I $$GET1^DIQ(52.49,ERXIEN,95.1,"I"),$$CS^PSOERXA0($$GET1^DIQ(52.49,ERXIEN,3.2,"I")) D
. . S PKID=1,PKIE="Processing Digitally Signed eRx order"
;
D:'$G(ACP) EN^PSOLMPO S:$G(ACP) VALMBCK="Q" D:$G(PKI1)=2 DCP^PSOPKIV1
Q
POST ;post patient selection
D POST^PSOORFI2 Q
SIG ;displays possible sig
D SIG^PSOORFI2 Q
INST ;displays provider comments and pharmacy instructions
S INST=0 F S INST=$O(^PS(52.41,ORD,TY,INST)) Q:'INST D ;PSO*210
. S (MIG,INST(INST))=^PS(52.41,ORD,TY,INST,0)
. D WORDWRAP^PSOUTLA2(MIG,.IEN,$NA(^TMP("PSOPO",$J)),20)
K INST,TY,MIG,SG
Q
OBX ;formats obx section
D OBX^PSOORFI4
Q
ST(PSRT) ;sort by route or patient
W !!,"Enter: ",!
I $G(PSRT)'="PA" W " 'PA' to process orders by patients",!
I $G(PSRT)'="RT" D ;PAPI 441
.N RESULTS,PSOPARKX
.S RESULTS="PSOPARKX" D GETPARK^PSORPC01()
. ;I '$P($G(PSOPAR),"^",34) W " 'RT' to process orders by route (mail/window)",!
. ;I $P($G(PSOPAR),"^",34) W " 'RT' to process orders by route (mail/window/park)",!
.I $G(PSOPARKX(0))'="YES" W " 'RT' to process orders by route (mail/window)",!
.I $G(PSOPARKX(0))="YES" W " 'RT' to process orders by route (mail/window/park)",!
I $G(PSRT)'="PR" W " 'PR' to process orders by priority",!
I $G(PSRT)'="CL" W " 'CL' to process orders by clinic",!
I $G(PSRT)'="FL" W " 'FL' to process flagged orders",!
I $G(PSRT)']"" W " 'CS' to process digitally signed CS orders",!
I $G(PSRT)]"","SUCS"'[$G(PSRT) W " 'CS' to process digitally signed CS orders",!
I $G(PSRT)']"" W " 'SU' to process supply item orders",!
I $G(PSRT)]"","SUCS"'[$G(PSRT) W " 'SU' to process supply item orders",!
I $D(PSRT) W " or 'C' to continue with one filter ",!
W " or 'E' or '^' to exit" W ! Q
RT ;which route to sort by ;PAPI 441
N RESULTS,PSOPARKX
S RESULTS="PSOPARKX" D GETPARK^PSORPC01()
W !!,"Enter 'W' to process window orders first"
W !," 'M' to process mail orders first"
;I $P($G(PSOPAR),"^",34) W !," 'P' to process park orders first"
I $G(PSOPARKX(0))="YES" W !," 'P' to process park orders first"
W !," 'C' to process orders administered in clinic first"
W !," or 'E' or '^' to exit" Q
PT ;process for all or one patient
W !!,"Enter 'A' to process all patient orders",!," 'S' to process orders for a patient",!," or 'E' or '^' to exit" Q
EP ;continue processing or not
W !,"If you want to continue processing orders Press RETURN or enter '^' to exit" Q
;
LOCK ;
N SAVELKTM
; Altering Lock Timout for MbM sites for this specific Lock to support volume eRx Processing
I $$GET1^DIQ(59.7,1,102,"I")="MBM" S SAVELKTM=DILOCKTM,DILOCKTM=.01
S PSOPLCK=$$L^PSSLOCK(PAT,0) I '$G(PSOPLCK) D LOCK^PSOORCPY S POERR("QFLG")=1
I $$GET1^DIQ(59.7,1,102,"I")="MBM" S DILOCKTM=SAVELKTM
K PSOPLCK
Q
ULK S X=PAT_";DPT(" D ULK^ORX2 S:$G(PSOQUIT) POERR("QFLG")=1 ; not called anymore
Q
LOCK1 ;
I $P($G(^PS(52.41,ORD,0)),"^",24) S PSOACT=$S($D(^XUSEC("PSDRPH",DUZ)):"DEFX",$D(^XUSEC("PSORPH",DUZ)):"F",'$D(^XUSEC("PSORPH",DUZ))&($P($G(PSOPAR),"^",2)):"F",1:"")
E S PSOACT=$S($D(^XUSEC("PSORPH",DUZ)):"DEFX",'$D(^XUSEC("PSORPH",DUZ))&($P($G(PSOPAR),"^",2)):"F",1:"")
Q
EX K DRET,SIG,PSODRUG,PRC,PHI
K DIR,DIRUT,DUOUT,DIRUT,X,Y,DIC,POERR,PSONEW,PSOSD,MAIL,CLI,WIN,OR0,OR1,OR2,ORD,SRT,PSRT,PSODFN,PSOFROM,T,OR3,PAT,%,%T,%Y,DI,DQ,DR,DRG,STA,I,T1,PSOSORT,PSOCSP
K TO,TC,TZ,PSOCPAY,PSOBILL,PSOIBQS,GROUPCNT,AGROUP,AGROUP1,OBX,%,%I,%H,D0,DFN,PSORX,PSOPTPST,PSOQFLG,PT,RTN,TM,TM1,DIPGM,PSOID,PSOCNT,PSOLK,PSZFIN,PSZFZZ D KVA^VADPT
K PSOFDR,PSOQUIT,PSOFIN,^TMP("PSOAO",$J),^TMP("PSODA",$J),^TMP("PSOPO",$J),^TMP("PSOPF",$J),^TMP("PSOPI",$J),^TMP("PSOHDR",$J),MEDA,MEDP
K C,CC,CNT,CRIT,D,DGI,DGS,DREN,IT,JJ,LG,MM,NIEN,PSOD,PATA,PSDAYS,PSOACT,PSOBM,PSOCOU,PSOCOUU,PSOFLAG,PSON,PSONOOR,PSOOPT,PSOPF,PSOPI,PSRF,RXFL,SDA,SEG1,SER,SERS,SLPPL,STAT,Z,Z4,ZDA
D FULL^VALM1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSOORFI1 13563 printed Apr 09, 2024@21:37:31 Page 2
PSOORFI1 ;BIR/SAB - finish OP orders from OE/RR continued ;Dec 13, 2021@08:00:50
+1 ;;7.0;OUTPATIENT PHARMACY;**7,15,23,27,32,44,51,46,71,90,108,131,152,186,210,222,258,260,225,391,408,444,467,505,617,441,651,700**;DEC 1997;Build 261
+2 ;Ref. ^PS(50.7 supp. DBIA 2223
+3 ;Ref. ^PSDRUG( supp. DBIA 221
+4 ;Ref. L^PSSLOCK supp. DBIA 2789
+5 ;Ref. ^PS(50.606 supp. DBIA 2174
+6 ;Ref. ^PS(55 supp. DBIA 2228
+7 ;Ref. ULK^ORX2 supp. DBIA 867
+8 ;Ref. ^SC( supp. DBIA 10040
+9 ;Ref. ^VA(200 supp. DBIA 10060
+10 ;Ref. ^XUSEC( supp. DBIA 10076
+11 ;Ref. ULK^ORX2 DBIA 867
+12 ;Ref. KVA^VADPT supp. DBIA 10061
+13 ;Ref. FULL^VALM1 supp. DBIA 10116
+14 ;
+15 ;PSO*186 add call to function $$DEACHK
+16 ;PSO*210 add call to WORDWRAP api
+17 ;
+18 SET SIGOK=1
DSPL KILL ^TMP("PSOPO",$JOB),CLOZPAT,PSOPRC,PSODSPL
+1 SET (OI,PSODRUG("OI"))=$PIECE(OR0,"^",8)
SET PSODRUG("OIN")=$PIECE(^PS(50.7,$PIECE(OR0,"^",8),0),"^")
SET OID=$PIECE(OR0,"^",9)
+2 IF $PIECE($GET(OR0),"^",9)
SET POERR=1
SET DREN=$PIECE(OR0,"^",9)
DO DRG^PSOORDRG
KILL POERR
GOTO DRG
+3 IF '$PIECE(OR0,"^",9)
DO DREN^PSOORNW2
DRG IF $PIECE($GET(^PSDRUG(+$GET(PSODRUG("IEN")),"CLOZ1")),"^")="PSOCLO1"
DO CLOZ^PSOORFI2
+1 ;PSO*186 modify If/Else below to use DEACHK
+2 IF $GET(PSODRUG("DEA"))]""
Begin DoDot:1
+3 SET PSOCS=0
KILL DIR,DIC,PSOX
+4 NEW PSDEA,PSDAYS
SET PSDEA=PSODRUG("DEA")
SET PSDAYS=+$PIECE(OR0,"^",22)
+5 IF $$DEACHK^PSOUTLA1("*",PSDEA,PSDAYS,$GET(CLOZPAT),.PSOCS,.PSOMAX)
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 SET PSOMAX=$SELECT($GET(CLOZPAT)=2:3,$GET(CLOZPAT)=1:1,1:$PIECE(OR0,"^",11))
End DoDot:1
ISSDT SET (PSOID,Y,PSONEW("ISSUE DATE"))=$SELECT($GET(PSONEW("ISSUE DATE")):PSONEW("ISSUE DATE"),$PIECE($GET(OR0),"^",6):$EXTRACT($PIECE(OR0,"^",6),1,7),1:DT)
+1 XECUTE ^DD("DD")
SET PSONEW("ISSUE DATE")=Y
+2 DO USER^PSOORFI2($PIECE(OR0,"^",4))
SET PSONEW("CLERK CODE")=$PIECE(OR0,"^",4)
SET PSORX("CLERK CODE")=USER1
+3 SET (PSONEW("DFLG"),PSONEW("QFLG"))=0
SET PSODFN=$PIECE(OR0,"^",2)
SET PSONEW("QTY")=$PIECE(OR0,"^",10)
SET PSONEW("MAIL/WINDOW")=$SELECT($PIECE(OR0,"^",17)="M":"M",$PIECE(OR0,"^",17)="P":"P",1:"W")
+4 if $GET(PSONEW("CLINIC"))']""
SET PSONEW("CLINIC")=+$PIECE(OR0,"^",13)
SET PSORX("CLINIC")=$SELECT($DATA(^SC(PSONEW("CLINIC"),0)):$PIECE(^SC(PSONEW("CLINIC"),0),"^"),1:"")
+5 if $GET(PSORX("CLINIC"))']""
SET PSORX("CLINIC")=$SELECT($DATA(^SC(+$PIECE(OR0,"^",13),0)):$PIECE(^SC($PIECE(OR0,"^",13),0),"^"),1:"")
+6 DO USER^PSOORFI2($PIECE(OR0,"^",5))
+7 SET PSONEW("CLERK CODE")=$PIECE(OR0,"^",4)
SET PSONEW("PROVIDER")=$PIECE(OR0,"^",5)
SET PSONEW("PROVIDER NAME")=USER1
+8 SET PSONEW("PATIENT STATUS")=$SELECT(+$GET(^PS(55,PSODFN,"PS")):+$GET(^PS(55,PSODFN,"PS")),1:"")
+9 SET PSONEW("CHCS NUMBER")=$SELECT($PIECE($GET(^PS(52.41,+$GET(ORD),"EXT")),"^")'="":$PIECE($GET(^("EXT")),"^"),1:"")
+10 SET PSONEW("EXTERNAL SYSTEM")=$SELECT($PIECE($GET(^PS(52.41,+$GET(ORD),"EXT")),"^",3)'="":$PIECE($GET(^("EXT")),"^",3),1:"")
+11 IF $PIECE(OR0,"^",22)>0
SET PSONEW("DAYS SUPPLY")=$PIECE(OR0,"^",22)
GOTO DS
+12 SET PSONEW("DAYS SUPPLY")=$SELECT(+$GET(^PS(55,PSODFN,"PS"))&($PIECE($GET(^PS(53,+$GET(^PS(55,PSODFN,"PS")),0)),"^",3)):$PIECE(^PS(53,+$GET(^PS(55,PSODFN,"PS")),0),"^",3),1:30)
DS ;
+1 if $DATA(CLOZPAT)
SET PSONEW("DAYS SUPPLY")=$SELECT(CLOZPAT=2&(PSONEW("DAYS SUPPLY")>28):28,CLOZPAT=1&(PSONEW("DAYS SUPPLY")>14):14,'CLOZPAT&(PSONEW("DAYS SUPPLY")>7):7,1:PSONEW("DAYS SUPPLY"))
+2 ; Display Order Checks Information
SET IEN=0
DO OBX
+3 ; Display Flag/Unflag Information
DO LMDISP^PSOORFI5(+$GET(ORD))
+4 ;Setup for N/F & DIN indicator
DO DIN^PSONFI(PSODRUG("OI"),$SELECT($DATA(PSODRUG("IEN")):PSODRUG("IEN"),1:""))
+5 ; pso*7*467 - add display of erx information if the rx came from eRx
+6 NEW ERXIEN
+7 SET ERXIEN=$$CHKERX^PSOERXU1(OR0)
IF ERXIEN
DO DERX1^PSOERXU1($NAME(^TMP("PSOPO",$JOB)),ERXIEN,"",.IEN,"P")
+8 ; pso*7*467 - end eRx enhancement
+9 ;*441-IND
if $PIECE($GET(^PS(52.41,ORD,4)),"^",2)]""
SET PSONEW("IND")=$PIECE($GET(^PS(52.41,ORD,4)),"^",2)
+10 if $PIECE($GET(^PS(52.41,ORD,4)),"^",3)]""
SET PSONEW("INDO")=$PIECE($GET(^PS(52.41,ORD,4)),"^",3)
+11 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)="*(1) Orderable Item: "_$PIECE(^PS(50.7,PSODRUG("OI"),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")_NFIO
+12 if NFIO["<DIN>"
SET NFIO=IEN_","_($LENGTH(^TMP("PSOPO",$JOB,IEN,0))-4)
+13 ;
+14 KILL LST
IF $GET(PSODRUG("NAME"))]""
Begin DoDot:1
+15 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (2)"_$SELECT($DATA(^PSDRUG("AQ",PSODRUG("IEN"))):" CMOP ",1:" ")_"Drug: "_PSODRUG("NAME")_NFID
+16 if NFID["<DIN>"
SET NFID=IEN_","_($LENGTH(^TMP("PSOPO",$JOB,IEN,0))-4)
+17 IF $PIECE(^PSDRUG(PSODRUG("IEN"),0),"^",10)]""
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Drug Message:"
DO DRGMSG^PSOORNEW
End DoDot:1
GOTO PST
+18 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (2) Drug: No Dispense Drug Selected"
PST DO DOSE^PSOORFI4
KILL PSOINSFL
+1 SET PSOINSFL=$PIECE($GET(^PS(52.41,ORD,"INS")),"^",2)
+2 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (4) Pat Instruct:"
DO INST^PSOORFI4
+3 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Provider Comments:"
SET TY=3
DO INST
+4 ;*441-IND
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Indications: "_$GET(PSONEW("IND"))
+5 IF $GET(ERXIEN)
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" eRx Drug: "_$$GET1^DIQ(52.49,ERXIEN,3.1)
+6 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" "_$SELECT($GET(ERXIEN):"eRx",1:" ")_" Instructions: "
SET TY=2
DO INST
+7 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" SIG:"
DO SIG
+8 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (5) Patient Status: "_$PIECE($GET(^PS(53,+PSONEW("PATIENT STATUS"),0)),"^")
+9 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (6) Issue Date: "_PSONEW("ISSUE DATE")
+10 SET (Y,PSONEW("FILL DATE"))=$SELECT($EXTRACT($PIECE(OR0,"^",6),1,7)<DT:DT,1:$EXTRACT($PIECE(OR0,"^",6),1,7))
XECUTE ^DD("DD")
SET PSORX("FILL DATE")=Y
SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_" (7) Fill Date: "_Y
+11 IF $PIECE(OR0,"^",18)
Begin DoDot:1
+12 SET IEN=IEN+1
SET Y=$PIECE(OR0,"^",18)
XECUTE ^DD("DD")
SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",39)="Effective Date: "_Y
End DoDot:1
+13 if $DATA(CLOZPAT)
DO ELIG^PSOORFI2
DO CLQTY^PSOORFI4
+14 NEW PSDAYS,MAXRF
+15 SET PSDAYS=$SELECT($GET(PSONEW("DAYS SUPPLY")):PSONEW("DAYS SUPPLY"),+$GET(^PS(55,PSODFN,"PS"))&($PIECE(^PS(53,+$GET(^PS(55,PSODFN,"PS")),0),"^",3)):$PIECE(^PS(53,+$GET(^PS(55,PSODFN,"PS")),0),"^",3),1:"")
+16 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (8) Days Supply: "_PSDAYS
+17 SET RXPT=+$GET(^PS(55,PSODFN,"PS"))
+18 ; Retrieving the Maximum Number of Refills allowed
+19 SET MAXRF=$$MAXNUMRF^PSOUTIL(+$GET(PSODRUG("IEN")),PSDAYS,RXPT,.CLOZPAT)
+20 SET PSONEW("# OF REFILLS")=$SELECT(+$PIECE(OR0,"^",11)>MAXRF:MAXRF,1:+$PIECE(OR0,"^",11))
+21 KILL RXPT
+22 ;
+23 SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_" (9) QTY"_$SELECT($PIECE($GET(^PSDRUG(+$GET(PSODRUG("IEN")),660)),"^",8)]"":" ("_$PIECE($GET(^PSDRUG(+$GET(PSODRUG("IEN")),660)),"^",8)_")",1:" ( )")_": "_$GET(PSONEW("QTY
"))
+24 IF $PIECE($GET(^PSDRUG(+$GET(PSODRUG("IEN")),5)),"^")]""
Begin DoDot:1
+25 SET $PIECE(RN," ",79)=" "
SET IEN=IEN+1
+26 SET ^TMP("PSOPO",$JOB,IEN,0)=$EXTRACT(RN,$LENGTH("QTY DSP MSG: "_$PIECE(^PSDRUG(PSODRUG("IEN"),5),"^"))+1,79)_"QTY DSP MSG: "_$PIECE(^PSDRUG(PSODRUG("IEN"),5),"^")
KILL RN
End DoDot:1
+27 SET IEN=IEN+1
+28 IF $PIECE(OR0,"^",24)
SET ^TMP("PSOPO",$JOB,IEN,0)=" Provider ordered: days supply "_$PIECE(OR0,"^",22)_", quantity "_$PIECE(OR0,"^",10)_" & refills "_+$PIECE(OR0,"^",11)
+29 IF '$TEST
SET ^TMP("PSOPO",$JOB,IEN,0)=" Provider ordered "_+$PIECE(OR0,"^",11)_" refills"
+30 if $DATA(CLOZPAT)
DO PQTY^PSOORFI4
+31 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)="(10) # of Refills: "_PSONEW("# OF REFILLS")_$EXTRACT(" ",$LENGTH(PSONEW("# OF REFILLS"))+1,2)_" (11) Routing: "_$SELECT(...
... $GET(PSONEW("MAIL/WINDOW"))="M":"MAIL",$GET(PSONEW("MAIL/WINDOW"))="P":"PARK",1:"WINDOW")
+32 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)="(12) Clinic: "_PSORX("CLINIC")
+33 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)="(13) Provider: "_PSONEW("PROVIDER NAME")
+34 IF $GET(PKI)
IF +$GET(PSODRUG("DEA"))>1
IF +$GET(PSODRUG("DEA"))<6
DO PRV^PSOORFI5($PIECE(OR0,"^",5),$PIECE(OR0,"^",9),$PIECE(OR0,"^"))
+35 IF $PIECE($GET(^VA(200,$SELECT($GET(PSONEW("PROVIDER")):PSONEW("PROVIDER"),1:$PIECE(OR0,"^",5)),"PS")),"^",7)&($PIECE($GET(^("PS")),"^",8))
SET PSONEW("COSIGNING PROVIDER")=$PIECE(^("PS"),"^",8)
Begin DoDot:1
+36 DO USER^PSOORFI2(PSONEW("COSIGNING PROVIDER"))
+37 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Cos-Provider: "_USER1
End DoDot:1
+38 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)="(14) Copies: 1"
+39 SET PSONEW("REMARKS")=$SELECT($PIECE(OR0,"^",17)="C":"Administered in Clinic.",1:"")
+40 KILL PSONEW("ADMINCLINIC")
if $PIECE(OR0,"^",17)="C"
SET PSONEW("ADMINCLINIC")=1
+41 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)="(15) Remarks: "_$SELECT($GET(PSONEW("REMARKS"))]"":PSONEW("REMARKS"),1:"")
+42 DO USER^PSOORFI2($PIECE(OR0,"^",4))
+43 SET $PIECE(RN," ",35)=" "
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Entry By: "_USER1_$EXTRACT(RN,$LENGTH(USER1)+1,35)
+44 SET Y=$PIECE(OR0,"^",12)
XECUTE ^DD("DD")
SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_"Entry Date: "_$EXTRACT($PIECE(OR0,"^",12),4,5)_"/"_$EXTRACT($PIECE(OR0,"^",12),6,7)_"/"_$EXTRACT($PIECE(OR0,"^",12),2,3)_" "_$PIECE(Y,"@",2)
KILL RN
+45 ; DEA compliance note for eRx CS prescriptions
+46 SET ERXIEN=$$ERXIEN^PSOERXUT($GET(ORD)_"P")
+47 IF ERXIEN
IF $$GET1^DIQ(52.49,ERXIEN,95.1,"I")
IF $$CS^PSOERXA0(+$$GET1^DIQ(52.49,ERXIEN,3.2,"I"))
Begin DoDot:1
+48 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=""
+49 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)="This prescription meets the requirements of the Drug Enforcement Administration"
+50 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)="(DEA) electronic prescribing for controlled substances rules (21 CFR Parts 1300,"
+51 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)="1304, 1306, & 1311)."
End DoDot:1
+52 IF $PIECE(OR0,"^",24)
SET PSOACT=$SELECT($DATA(^XUSEC("PSDRPH",DUZ)):"DEFX",$DATA(^XUSEC("PSORPH",DUZ)):"F",$PIECE($GET(PSOPAR),"^",2):"F",1:"")
Begin DoDot:1
+53 KILL PSOCSP
SET PSOCSP("NAME")=$GET(PSODRUG("NAME"))
MERGE PSOCSP("DOSE")=PSONEW("DOSE"),PSOCSP("DOSE ORDERED")=PSONEW("DOSE ORDERED")
+54 ;track original data for dig. orders
SET PSOCSP("# OF REFILLS")=PSONEW("# OF REFILLS")
+55 SET PSOCSP("ISSUE DATE")=$EXTRACT($PIECE(OR0,"^",6),1,7)
SET PSOCSP("QTY")=PSONEW("QTY")
SET PSOCSP("DAYS SUPPLY")=PSONEW("DAYS SUPPLY")
End DoDot:1
+56 IF '$TEST
SET PSOACT=$SELECT($DATA(^XUSEC("PSORPH",DUZ)):"DEFX",'$DATA(^XUSEC("PSORPH",DUZ))&($PIECE($GET(PSOPAR),"^",2)):"F",1:"")
+57 ; - PSOACTOV is used to force the Pending Order to be Read-Only (no updates) even if invoked by a Pharmacist
+58 IF $GET(PSOACTOV)
SET PSOACT=""
+59 ; eRx Pending Order (Side-By-Side) Interface (Replaces conventional interface above)
+60 SET ERXIEN=$$ERXIEN^PSOERXUT($GET(ORD)_"P")
+61 IF ERXIEN
Begin DoDot:1
+62 IF $DATA(VALMEVL)
FOR I=1:1:99
DO RESTORE^VALM10(I)
+63 SET (IEN,LINE)=0
KILL ^TMP("PSOPO",$JOB)
+64 DO SETPEN^PSOERUT5("PSOPO",ERXIEN,+ORD,.PSONEW,.PSODRUG,,0)
SET (VALMCNT,IEN)=LINE-1
+65 IF $$GET1^DIQ(52.49,ERXIEN,95.1,"I")
IF $$CS^PSOERXA0($$GET1^DIQ(52.49,ERXIEN,3.2,"I"))
Begin DoDot:2
+66 SET PKID=1
SET PKIE="Processing Digitally Signed eRx order"
End DoDot:2
End DoDot:1
+67 ;
+68 if '$GET(ACP)
DO EN^PSOLMPO
if $GET(ACP)
SET VALMBCK="Q"
if $GET(PKI1)=2
DO DCP^PSOPKIV1
+69 QUIT
POST ;post patient selection
+1 DO POST^PSOORFI2
QUIT
SIG ;displays possible sig
+1 DO SIG^PSOORFI2
QUIT
INST ;displays provider comments and pharmacy instructions
+1 ;PSO*210
SET INST=0
FOR
SET INST=$ORDER(^PS(52.41,ORD,TY,INST))
if 'INST
QUIT
Begin DoDot:1
+2 SET (MIG,INST(INST))=^PS(52.41,ORD,TY,INST,0)
+3 DO WORDWRAP^PSOUTLA2(MIG,.IEN,$NAME(^TMP("PSOPO",$JOB)),20)
End DoDot:1
+4 KILL INST,TY,MIG,SG
+5 QUIT
OBX ;formats obx section
+1 DO OBX^PSOORFI4
+2 QUIT
ST(PSRT) ;sort by route or patient
+1 WRITE !!,"Enter: ",!
+2 IF $GET(PSRT)'="PA"
WRITE " 'PA' to process orders by patients",!
+3 ;PAPI 441
IF $GET(PSRT)'="RT"
Begin DoDot:1
+4 NEW RESULTS,PSOPARKX
+5 SET RESULTS="PSOPARKX"
DO GETPARK^PSORPC01()
+6 ;I '$P($G(PSOPAR),"^",34) W " 'RT' to process orders by route (mail/window)",!
+7 ;I $P($G(PSOPAR),"^",34) W " 'RT' to process orders by route (mail/window/park)",!
+8 IF $GET(PSOPARKX(0))'="YES"
WRITE " 'RT' to process orders by route (mail/window)",!
+9 IF $GET(PSOPARKX(0))="YES"
WRITE " 'RT' to process orders by route (mail/window/park)",!
End DoDot:1
+10 IF $GET(PSRT)'="PR"
WRITE " 'PR' to process orders by priority",!
+11 IF $GET(PSRT)'="CL"
WRITE " 'CL' to process orders by clinic",!
+12 IF $GET(PSRT)'="FL"
WRITE " 'FL' to process flagged orders",!
+13 IF $GET(PSRT)']""
WRITE " 'CS' to process digitally signed CS orders",!
+14 IF $GET(PSRT)]""
IF "SUCS"'[$GET(PSRT)
WRITE " 'CS' to process digitally signed CS orders",!
+15 IF $GET(PSRT)']""
WRITE " 'SU' to process supply item orders",!
+16 IF $GET(PSRT)]""
IF "SUCS"'[$GET(PSRT)
WRITE " 'SU' to process supply item orders",!
+17 IF $DATA(PSRT)
WRITE " or 'C' to continue with one filter ",!
+18 WRITE " or 'E' or '^' to exit"
WRITE !
QUIT
RT ;which route to sort by ;PAPI 441
+1 NEW RESULTS,PSOPARKX
+2 SET RESULTS="PSOPARKX"
DO GETPARK^PSORPC01()
+3 WRITE !!,"Enter 'W' to process window orders first"
+4 WRITE !," 'M' to process mail orders first"
+5 ;I $P($G(PSOPAR),"^",34) W !," 'P' to process park orders first"
+6 IF $GET(PSOPARKX(0))="YES"
WRITE !," 'P' to process park orders first"
+7 WRITE !," 'C' to process orders administered in clinic first"
+8 WRITE !," or 'E' or '^' to exit"
QUIT
PT ;process for all or one patient
+1 WRITE !!,"Enter 'A' to process all patient orders",!," 'S' to process orders for a patient",!," or 'E' or '^' to exit"
QUIT
EP ;continue processing or not
+1 WRITE !,"If you want to continue processing orders Press RETURN or enter '^' to exit"
QUIT
+2 ;
LOCK ;
+1 NEW SAVELKTM
+2 ; Altering Lock Timout for MbM sites for this specific Lock to support volume eRx Processing
+3 IF $$GET1^DIQ(59.7,1,102,"I")="MBM"
SET SAVELKTM=DILOCKTM
SET DILOCKTM=.01
+4 SET PSOPLCK=$$L^PSSLOCK(PAT,0)
IF '$GET(PSOPLCK)
DO LOCK^PSOORCPY
SET POERR("QFLG")=1
+5 IF $$GET1^DIQ(59.7,1,102,"I")="MBM"
SET DILOCKTM=SAVELKTM
+6 KILL PSOPLCK
+7 QUIT
ULK ; not called anymore
SET X=PAT_";DPT("
DO ULK^ORX2
if $GET(PSOQUIT)
SET POERR("QFLG")=1
+1 QUIT
LOCK1 ;
+1 IF $PIECE($GET(^PS(52.41,ORD,0)),"^",24)
SET PSOACT=$SELECT($DATA(^XUSEC("PSDRPH",DUZ)):"DEFX",$DATA(^XUSEC("PSORPH",DUZ)):"F",'$DATA(^XUSEC("PSORPH",DUZ))&($PIECE($GET(PSOPAR),"^",2)):"F",1:"")
+2 IF '$TEST
SET PSOACT=$SELECT($DATA(^XUSEC("PSORPH",DUZ)):"DEFX",'$DATA(^XUSEC("PSORPH",DUZ))&($PIECE($GET(PSOPAR),"^",2)):"F",1:"")
+3 QUIT
EX KILL DRET,SIG,PSODRUG,PRC,PHI
+1 KILL DIR,DIRUT,DUOUT,DIRUT,X,Y,DIC,POERR,PSONEW,PSOSD,MAIL,CLI,WIN,OR0,OR1,OR2,ORD,SRT,PSRT,PSODFN,PSOFROM,T,OR3,PAT,%,%T,%Y,DI,DQ,DR,DRG,STA,I,T1,PSOSORT,PSOCSP
+2 KILL TO,TC,TZ,PSOCPAY,PSOBILL,PSOIBQS,GROUPCNT,AGROUP,AGROUP1,OBX,%,%I,%H,D0,DFN,PSORX,PSOPTPST,PSOQFLG,PT,RTN,TM,TM1,DIPGM,PSOID,PSOCNT,PSOLK,PSZFIN,PSZFZZ
DO KVA^VADPT
+3 KILL PSOFDR,PSOQUIT,PSOFIN,^TMP("PSOAO",$JOB),^TMP("PSODA",$JOB),^TMP("PSOPO",$JOB),^TMP("PSOPF",$JOB),^TMP("PSOPI",$JOB),^TMP("PSOHDR",$JOB),MEDA,MEDP
+4 KILL C,CC,CNT,CRIT,D,DGI,DGS,DREN,IT,JJ,LG,MM,NIEN,PSOD,PATA,PSDAYS,PSOACT,PSOBM,PSOCOU,PSOCOUU,PSOFLAG,PSON,PSONOOR,PSOOPT,PSOPF,PSOPI,PSRF,RXFL,SDA,SEG1,SER,SERS,SLPPL,STAT,Z,Z4,ZDA
+5 DO FULL^VALM1
+6 QUIT
