PSOORFI1 ;BIR/SAB - finish OP orders from OE/RR continued ;04-Jun-2013 22:36;PLS
;;7.0;OUTPATIENT PHARMACY;**7,15,23,27,32,44,51,46,71,90,108,131,152,1003,1005,1006,1008,1013,186,210,222,258,260,225,1015,1016,1017**;DEC 1997;Build 40
;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
;
;PSO*186 add call to function $$DEACHK
;PSO*210 add call to WORDWRAP api
; Modified - IHS/CIA/PLS - 01/26/04 - Line PST+37
; 02/09/05 - Added line ISSDT+11
; IHS/MCS/PLS - 09/17/07 - ISSDT+12 - Added logic to set clinical indicator
; 03/06/08 - ISSDT+14 - Added logic to set Substitution response
; 03/13/08 - PST+46 - Added line for Substitution display
; 01/23/09 - PST+47 - Added line for Cash Due display
; 10/24/11 - OBX+1
; IHS/MSC/PB 08/03/12 - Line tag SIGN added at line PST+8 to pull the SIGNS and SYMPTOMS and the INDICATION CODES for display
; IHS/MSC/PLS 12/06/12 - PST+19
; 06/04/13 - Added line for Discharge Medication
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",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:"")
S PSONEW("CM")=$S($L($$VALUE^ORCSAVE2(+OR0,"CMF")):$$VALUE^ORCSAVE2(+OR0,"CMF"),APSPCMP=2:"Y",APSPCMP=3:"",1:"N") ; IHS/CIA/PLS - 01/28/09 - Added check for no default
S PSONEW("CLININD")=$S($L($$VALUE^ORCSAVE2(+OR0,"CLININD")):$$VALUE^ORCSAVE2(+OR0,"CLININD"),1:"")
S PSONEW("CLININD2")=$S($L($$VALUE^ORCSAVE2(+OR0,"CLININD2")):$$VALUE^ORCSAVE2(+OR0,"CLININD2"),1:"")
S PSONEW("DAW")=$S($L($$VALUE^ORCSAVE2(+OR0,"DAW")):$$VALUE^ORCSAVE2(+OR0,"DAW"),1:"") ; IHS/MSC/PLS - 03/06/08 - Allow Substitutions
S PSONEW("DSCMED")=$S($L($$VALUE^ORCSAVE2(+OR0,"DSCMED")):$$VALUE^ORCSAVE2(+OR0,"DSCMED"),1:"") ;IHS/MSC/PLS - 06/04/13
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
I $G(PKI1)!($G(PKI)=1) D L1^PSOPKIV1 K:$G(PKI)=1 PKI
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)
D FULL^VALM1 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)=" Instructions:" S TY=2 D INST
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" SIG:" D SIG
;IHS/MSC/PB - 08/03/12 Next line added to pull the SIGNS and SYMPTOMS and the INDICATION CODE for display
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="Clinical Indication: "_$G(PSONEW("CLININD"))_" "_$G(PSONEW("CLININD2"))
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
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (8) Days Supply: "_$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:"")
I +$G(^PS(55,PSODFN,"PS")) S RXPT=+^("PS") I $G(^PS(53,RXPT,0))]"" D
.S PSONEW("# OF REFILLS")=$S(+$P(OR0,"^",11)>+$P(^PS(53,RXPT,0),"^",4):+$P(^PS(53,RXPT,0),"^",4),1:+$P(OR0,"^",11)),PSOX=+$P(^PS(53,RXPT,0),"^",4)
.S PSONEW("# OF REFILLS")=$S(PSONEW("# OF REFILLS")>PSOMAX:PSOMAX,1:PSONEW("# OF REFILLS"))
.S PSOMAX=$S(PSOMAX>+$P(^PS(53,RXPT,0),"^",4):+$P(^PS(53,RXPT,0),"^",4),1:PSOMAX) K RXPT
.S MPSDY=PSONEW("DAYS SUPPLY")
.;I PSOMAX=5 S MAXRF=$S(MPSDY<60:5,MPSDY'<60&(MPSDY'>89):2,1:1) I PSONEW("# OF REFILLS")>MAXRF S PSONEW("# OF REFILLS")=MAXRF K MAXRF,MPSDY Q
.;IHS/MSC/PLS - 12/06/2012
.;S MAXRF=$S(MPSDY<60:11,MPSDY'<60&(MPSDY'>89):5,MPSDY=90:3,1:0)
.S MAXRF=$S(MPSDY<60:15,MPSDY<90:5,MPSDY=90:3,MPSDY<168:2,MPSDY<365:1,1:0)
.I PSONEW("# OF REFILLS")>MAXRF S PSONEW("# OF REFILLS")=MAXRF K MAXRF,MPSDY
E D
. I $G(PSOMAX) S PSONEW("# OF REFILLS")=$S(+$P(OR0,"^",11)>PSOMAX:PSOMAX,1:+$P(OR0,"^",11)) Q
.S PSONEW("# OF REFILLS")=+$P(OR0,"^",11)
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:" ( )")_": "
S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_$S($D(CLOZPAT):+$G(PSONEW("QTY")),1:$P(OR0,"^",10))
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,^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",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 $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:"")
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="(15) Remarks: "_$S($G(PSONEW("REMARKS"))]"":PSONEW("REMARKS"),1:"")
; IHS/CIA/PLS - 01/26/04 - Add IHS Fields to display
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="Enter a zero (0) to edit IHS specific fields."
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" NDC: "_$G(PSODRUG("NDC"))
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" AWP: "_$G(PSONEW("AWP"))_" Unit Cost: "_$G(PSONEW("COST")) ; IHS/CIA/PLS - 01/15/04
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Triplicate #: "_$G(PSONEW("TRIP")) ; IHS/CIA/PLS - 01/15/04
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Bill Status: "_$$EXTERNAL^DILFD(52,9999999.07,,$G(PSONEW("BST")))
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Manufacturer: "_$G(PSONEW("MANUFACTURER"))_" Lot #: "_$G(PSODIR("LOT #"))_" ExpDate: "_$$FMTE^XLFDT($G(PSODIR("EXPIRATION DATE")))
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Chronic Med: "_$$EXTERNAL^DILFD(52,9999999.02,,$G(PSONEW("CM")))
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Substitution: "_$$EXTERNAL^DILFD(52,9999999.25,,$G(PSONEW("DAW"))) ;IHS/MSC/PLS - 03/13/08
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)="Discharge Medication: "_$$EXTERNAL^DILFD(52,9999999.28,,$G(PSONEW("DSCMED"))) ;IHS/MSC/PLS - 06/04/13
S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Cash Due: "_$$EXTERNAL^DILFD(52,9999999.26,,$G(PSONEW("CASH DUE"))) ; IHS/MSC/PLS - 01/23/09
;S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Insurer: "_$G(PSONEW("INSURER"))
; End IHS Fields
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
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=""
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
I 1 D
.N X
.S X="IORVON;IORVOFF;IOBON;IOBOFF" D ENDR^%ZISS ;Patch 1013
D OBX^PSOORFI4
Q
ST ;sort by route or patient
W !!,"Enter 'PA' to process orders by patients",!," 'RT' to process orders by route (mail/window)",!," 'PR' to process orders by priority",!," 'CL' to process orders by clinic"
W !," 'FL' to process flagged orders",!," or 'E' or '^' to exit" W ! Q
RT ;which route to sort by
W !!,"Enter 'W' to process window orders first",!," 'M' to process mail orders first",!," 'C' to process orders administered in clinic first",!," 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 S PSOPLCK=$$L^PSSLOCK(PAT,0) I '$G(PSOPLCK) D LOCK^PSOORCPY S POERR("QFLG")=1
K PSOPLCK
Q
ULK S X=PAT_";DPT(" D ULK^ORX2 S:$G(PSOQUIT) POERR("QFLG")=1 ; not called anymore
Q
LOCK1 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
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
PSOORFI1 ;BIR/SAB - finish OP orders from OE/RR continued ;04-Jun-2013 22:36;PLS
+1 ;;7.0;OUTPATIENT PHARMACY;**7,15,23,27,32,44,51,46,71,90,108,131,152,1003,1005,1006,1008,1013,186,210,222,258,260,225,1015,1016,1017**;DEC 1997;Build 40
+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 ;
+9 ;PSO*186 add call to function $$DEACHK
+10 ;PSO*210 add call to WORDWRAP api
+11 ; Modified - IHS/CIA/PLS - 01/26/04 - Line PST+37
+12 ; 02/09/05 - Added line ISSDT+11
+13 ; IHS/MCS/PLS - 09/17/07 - ISSDT+12 - Added logic to set clinical indicator
+14 ; 03/06/08 - ISSDT+14 - Added logic to set Substitution response
+15 ; 03/13/08 - PST+46 - Added line for Substitution display
+16 ; 01/23/09 - PST+47 - Added line for Cash Due display
+17 ; 10/24/11 - OBX+1
+18 ; IHS/MSC/PB 08/03/12 - Line tag SIGN added at line PST+8 to pull the SIGNS and SYMPTOMS and the INDICATION CODES for display
+19 ; IHS/MSC/PLS 12/06/12 - PST+19
+20 ; 06/04/13 - Added line for Discharge Medication
+21 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",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 ; IHS/CIA/PLS - 01/28/09 - Added check for no default
SET PSONEW("CM")=$SELECT($LENGTH($$VALUE^ORCSAVE2(+OR0,"CMF")):$$VALUE^ORCSAVE2(+OR0,"CMF"),APSPCMP=2:"Y",APSPCMP=3:"",1:"N")
+12 SET PSONEW("CLININD")=$SELECT($LENGTH($$VALUE^ORCSAVE2(+OR0,"CLININD")):$$VALUE^ORCSAVE2(+OR0,"CLININD"),1:"")
+13 SET PSONEW("CLININD2")=$SELECT($LENGTH($$VALUE^ORCSAVE2(+OR0,"CLININD2")):$$VALUE^ORCSAVE2(+OR0,"CLININD2"),1:"")
+14 ; IHS/MSC/PLS - 03/06/08 - Allow Substitutions
SET PSONEW("DAW")=$SELECT($LENGTH($$VALUE^ORCSAVE2(+OR0,"DAW")):$$VALUE^ORCSAVE2(+OR0,"DAW"),1:"")
+15 ;IHS/MSC/PLS - 06/04/13
SET PSONEW("DSCMED")=$SELECT($LENGTH($$VALUE^ORCSAVE2(+OR0,"DSCMED")):$$VALUE^ORCSAVE2(+OR0,"DSCMED"),1:"")
+16 IF $PIECE(OR0,"^",22)>0
SET PSONEW("DAYS SUPPLY")=$PIECE(OR0,"^",22)
GOTO DS
+17 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 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"))
+1 ; Display Order Checks Information
SET IEN=0
DO OBX
+2 ; Display Flag/Unflag Information
DO LMDISP^PSOORFI5(+$GET(ORD))
+3 ;Setup for N/F & DIN indicator
DO DIN^PSONFI(PSODRUG("OI"),$SELECT($DATA(PSODRUG("IEN")):PSODRUG("IEN"),1:""))
+4 IF $GET(PKI1)!($GET(PKI)=1)
DO L1^PSOPKIV1
IF $GET(PKI)=1
KILL PKI
+5 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
+6 IF NFIO["<DIN>"
SET NFIO=IEN_","_($LENGTH(^TMP("PSOPO",$JOB,IEN,0))-4)
+7 DO FULL^VALM1
KILL LST
IF $GET(PSODRUG("NAME"))]""
Begin DoDot:1
+8 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (2)"_$SELECT($DATA(^PSDRUG("AQ",PSODRUG("IEN"))):" CMOP ",1:" ")_"Drug: "_PSODRUG("NAME")_NFID
+9 IF NFID["<DIN>"
SET NFID=IEN_","_($LENGTH(^TMP("PSOPO",$JOB,IEN,0))-4)
+10 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
+11 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 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Instructions:"
SET TY=2
DO INST
+5 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" SIG:"
DO SIG
+6 ;IHS/MSC/PB - 08/03/12 Next line added to pull the SIGNS and SYMPTOMS and the INDICATION CODE for display
+7 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)="Clinical Indication: "_$GET(PSONEW("CLININD"))_" "_$GET(PSONEW("CLININD2"))
+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 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" (8) Days Supply: "_$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:
"")
+15 IF +$GET(^PS(55,PSODFN,"PS"))
SET RXPT=+^("PS")
IF $GET(^PS(53,RXPT,0))]""
Begin DoDot:1
+16 SET PSONEW("# OF REFILLS")=$SELECT(+$PIECE(OR0,"^",11)>+$PIECE(^PS(53,RXPT,0),"^",4):+$PIECE(^PS(53,RXPT,0),"^",4),1:+$PIECE(OR0,"^",11))
SET PSOX=+$PIECE(^PS(53,RXPT,0),"^",4)
+17 SET PSONEW("# OF REFILLS")=$SELECT(PSONEW("# OF REFILLS")>PSOMAX:PSOMAX,1:PSONEW("# OF REFILLS"))
+18 SET PSOMAX=$SELECT(PSOMAX>+$PIECE(^PS(53,RXPT,0),"^",4):+$PIECE(^PS(53,RXPT,0),"^",4),1:PSOMAX)
KILL RXPT
+19 SET MPSDY=PSONEW("DAYS SUPPLY")
+20 ;I PSOMAX=5 S MAXRF=$S(MPSDY<60:5,MPSDY'<60&(MPSDY'>89):2,1:1) I PSONEW("# OF REFILLS")>MAXRF S PSONEW("# OF REFILLS")=MAXRF K MAXRF,MPSDY Q
+21 ;IHS/MSC/PLS - 12/06/2012
+22 ;S MAXRF=$S(MPSDY<60:11,MPSDY'<60&(MPSDY'>89):5,MPSDY=90:3,1:0)
+23 SET MAXRF=$SELECT(MPSDY<60:15,MPSDY<90:5,MPSDY=90:3,MPSDY<168:2,MPSDY<365:1,1:0)
+24 IF PSONEW("# OF REFILLS")>MAXRF
SET PSONEW("# OF REFILLS")=MAXRF
KILL MAXRF,MPSDY
End DoDot:1
+25 IF '$TEST
Begin DoDot:1
+26 IF $GET(PSOMAX)
SET PSONEW("# OF REFILLS")=$SELECT(+$PIECE(OR0,"^",11)>PSOMAX:PSOMAX,1:+$PIECE(OR0,"^",11))
QUIT
+27 SET PSONEW("# OF REFILLS")=+$PIECE(OR0,"^",11)
End DoDot:1
+28 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:" ( )")_": "
+29 SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_$SELECT($DATA(CLOZPAT):+$GET(PSONEW("QTY")),1:$PIECE(OR0,"^",10))
+30 IF $PIECE($GET(^PSDRUG(+$GET(PSODRUG("IEN")),5)),"^")]""
Begin DoDot:1
+31 SET $PIECE(RN," ",79)=" "
SET IEN=IEN+1
+32 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
+33 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Provider ordered "_+$PIECE(OR0,"^",11)_" refills"
+34 IF $DATA(CLOZPAT)
DO PQTY^PSOORFI4
+35 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",1:"WINDOW")
+36 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)="(12) Clinic: "_PSORX("CLINIC")
+37 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)="(13) Provider: "_PSONEW("PROVIDER NAME")
+38 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
+39 DO USER^PSOORFI2(PSONEW("COSIGNING PROVIDER"))
+40 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Cos-Provider: "_USER1
End DoDot:1
+41 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)="(14) Copies: 1"
+42 SET PSONEW("REMARKS")=$SELECT($PIECE(OR0,"^",17)="C":"Administered in Clinic.",1:"")
+43 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)="(15) Remarks: "_$SELECT($GET(PSONEW("REMARKS"))]"":PSONEW("REMARKS"),1:"")
+44 ; IHS/CIA/PLS - 01/26/04 - Add IHS Fields to display
+45 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)="Enter a zero (0) to edit IHS specific fields."
+46 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" NDC: "_$GET(PSODRUG("NDC"))
+47 ; IHS/CIA/PLS - 01/15/04
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" AWP: "_$GET(PSONEW("AWP"))_" Unit Cost: "_$GET(PSONEW("COST"))
+48 ; IHS/CIA/PLS - 01/15/04
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Triplicate #: "_$GET(PSONEW("TRIP"))
+49 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Bill Status: "_$$EXTERNAL^DILFD(52,9999999.07,,$GET(PSONEW("BST")))
+50 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Manufacturer: "_$GET(PSONEW("MANUFACTURER"))_" Lot #: "_$GET(PSODIR("LOT #"))_" ExpDate: "_$$FMTE^XLFDT($GET(PSODIR("EXPIRATION DATE")))
+51 SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Chronic Med: "_$$EXTERNAL^DILFD(52,9999999.02,,$GET(PSONEW("CM")))
+52 ;IHS/MSC/PLS - 03/13/08
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Substitution: "_$$EXTERNAL^DILFD(52,9999999.25,,$GET(PSONEW("DAW")))
+53 ;IHS/MSC/PLS - 06/04/13
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)="Discharge Medication: "_$$EXTERNAL^DILFD(52,9999999.28,,$GET(PSONEW("DSCMED")))
+54 ; IHS/MSC/PLS - 01/23/09
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Cash Due: "_$$EXTERNAL^DILFD(52,9999999.26,,$GET(PSONEW("CASH DUE")))
+55 ;S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Insurer: "_$G(PSONEW("INSURER"))
+56 ; End IHS Fields
+57 DO USER^PSOORFI2($PIECE(OR0,"^",4))
+58 SET $PIECE(RN," ",35)=" "
SET IEN=IEN+1
SET ^TMP("PSOPO",$JOB,IEN,0)=" Entry By: "_USER1_$EXTRACT(RN,$LENGTH(USER1)+1,35)
+59 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
+60 SET PSOACT=$SELECT($DATA(^XUSEC("PSORPH",DUZ)):"DEFX",'$DATA(^XUSEC("PSORPH",DUZ))&($PIECE($GET(PSOPAR),"^",2)):"F",1:"")
+61 ; - PSOACTOV is used to force the Pending Order to be Read-Only (no updates) even if invoked by a Pharmacist
+62 IF $GET(PSOACTOV)
SET PSOACT=""
+63 IF '$GET(ACP)
DO EN^PSOLMPO
IF $GET(ACP)
SET VALMBCK="Q"
IF $GET(PKI1)=2
DO DCP^PSOPKIV1
+64 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 IF 1
Begin DoDot:1
+2 NEW X
+3 ;Patch 1013
SET X="IORVON;IORVOFF;IOBON;IOBOFF"
DO ENDR^%ZISS
End DoDot:1
+4 DO OBX^PSOORFI4
+5 QUIT
ST ;sort by route or patient
+1 WRITE !!,"Enter 'PA' to process orders by patients",!," 'RT' to process orders by route (mail/window)",!," 'PR' to process orders by priority",!," 'CL' to process orders by clinic"
+2 WRITE !," 'FL' to process flagged orders",!," or 'E' or '^' to exit"
WRITE !
QUIT
RT ;which route to sort by
+1 WRITE !!,"Enter 'W' to process window orders first",!," 'M' to process mail orders first",!," 'C' to process orders administered in clinic first",!," 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
LOCK SET PSOPLCK=$$L^PSSLOCK(PAT,0)
IF '$GET(PSOPLCK)
DO LOCK^PSOORCPY
SET POERR("QFLG")=1
+1 KILL PSOPLCK
+2 QUIT
ULK ; not called anymore
SET X=PAT_";DPT("
DO ULK^ORX2
IF $GET(PSOQUIT)
SET POERR("QFLG")=1
+1 QUIT
LOCK1 SET PSOACT=$SELECT($DATA(^XUSEC("PSORPH",DUZ)):"DEFX",'$DATA(^XUSEC("PSORPH",DUZ))&($PIECE($GET(PSOPAR),"^",2)):"F",1:"")
+1 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
+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
