- PSOORNE4 ;BIR/SAB-display renew RXs from backdoor ;04-Jun-2013 12:51;DU
- ;;7.0;OUTPATIENT PHARMACY;**11,27,32,36,46,75,96,103,99,117,131,1008,1009,1013,225,1015,1017**;DEC 1997;Build 40
- ;^SC DBIA-10040;^PS(50.7-2223;^PS(50.606-2174;^PS(50.607-2221;^PS(51.2-2226;^PSDRUG-221;^PS(55-2228
- ; Modified - IHS/CIA/PLS - 01/27/04 - Added display of IHS Fields
- ; IHS/MSC/PLS - 03/13/08 - Added line RMK+10
- ; 01/23/09 - Added line RMK+11
- ; 12/09/10 - Added line VER+17
- ; 10/31/11 - Added line PKI+3
- ; 06/04/13 - Added Discharge Medication
- EN(PSONEW) N FLD,LST,VALMCNT
- EN1 K PSOQUIT D:$G(PSONEW("ENT"))'>0 I $G(PSORENW("POE"))=1 S PSOREEDT=1 D SV
- .S PSOREEDT=1 D SV
- .K PSONEW("DOSE"),PSONEW("UNITS"),PSONEW("DOSE ORDERED"),PSONEW("ROUTE")
- .K PSONEW("SCHEDULE"),PSONEW("DURATION"),PSONEW("CONJUNCTION"),PSONEW("NOUN"),PSONEW("VERB"),PSOPRC,PSONEW("ODOSE")
- RDD D DSPL,^PSOLMRN D:$G(PKI1)=2 DCP^PSOPKIV1 I $G(PSORX("FN")) S VALMBCK="Q" K PSOREEDT Q
- G:'$G(PSOQUIT) RDD
- Q
- ; IHS/CIA/PLS - 01/27/04 - Commented out next to extend range to include zero
- EDT ;D KV^PSOVER1 S DIR("A")="Select Field to Edit by number",DIR(0)="LO^1:"_$S($G(PSOREEDT):10,1:8)
- D KV^PSOVER1 S DIR("A")="Select Field to Edit by number",DIR(0)="LO^0:"_$S($G(PSOREEDT):10,1:8)
- D ^DIR I $D(DTOUT)!($D(DUOUT)) D KV^PSOVER1 S VALMBCK="" Q
- EDTSEL S PSOLM=1,(PSONEW("DFLG"),PSONEW("FIELD"),PSONEW3)=0
- ; IHS/CIA/PLS - 01/27/04 - Changed to $L to include zero value
- ;I +Y S LST=Y D HLDHDR^PSOLMUTL S PSOEDT=1 D Q:$G(PSODIR("DFLG"))!($G(PSODIR("QFLG")))
- I $L(Y) S LST=Y D HLDHDR^PSOLMUTL S PSOEDT=1 D Q:$G(PSODIR("DFLG"))!($G(PSODIR("QFLG")))
- .F FLD=1:1:$L(LST,",") Q:$P(LST,",",FLD)']"" D @(+$P(LST,",",FLD)) Q:$G(PSODIR("DFLG"))!($G(PSODIR("QFLG")))
- E S VALMBCK="" D FULL^VALM1
- Q
- ACP I $G(PKI1)=1 D REA^PSOPKIV1 G:$G(PSONEW("QFLG"))=1 PKI
- D INST2^PSORENW S PSOFROM1=1 D:$D(^XUSEC("PSORPH",DUZ))!('$P(PSOPAR,"^",2)) VER
- K PSOFROM1
- PKI I $G(PSONEW("QFLG")) S POERR("DFLG")=1,VALMBCK="R" K PSONEW2 Q
- I PSONEW("ENT")>0,$G(NEWDOSE) K NEWDOSE G EN1 Q
- S PSORX("FN")=1 D EN^PSORN52(.PSONEW)
- D EN^APSPPCC1(PSODFN,PSONEW("IRXN")) ;P1013 - prompt for POV
- D RNPSOSD^PSOUTIL,ACP1^PSOORNE6,^PSOBUILD S VALMBCK="Q"
- Q
- VER1(PSONEW) ;
- VER S (PSONEW("DFLG"),PSONEW("QFLG"))=0 I PSONEW("ENT")=0 D K PSOORRNW,PSOFROM1 I PSONEW("DFLG")=1 S (PSONEW("QFLG"),POERR("DFLG"))=1 Q
- .S (PSOREEDT,PSOORRNW)=1 W !!,"Dosing Instruction Missing!!",!
- .S PSONEW("IRXN")=PSONEW("OIRXN") K VALMSG D FULL^VALM1 W !,"Drug: "_PSODRUG("NAME") D
- ..I $O(SIG(0)) D Q
- ...F I=1:1 Q:$G(SIG(I))']"" W !,SIG(I)
- ..I $P($G(^PSRX(PSONEW("OIRXN"),"SIG")),"^")]"" S X=$P(^PSRX(PSONEW("OIRXN"),"SIG"),"^") D SIGONE^PSOHELP W !,$E($G(INS1),2,250)
- .K DIRUT W ! D DOSE^PSODIR(.PSONEW) Q:$G(PSONEW("DFLG")) D EN^PSOFSIG(.PSONEW)
- .I PSONEW("ENT")>0,$O(SIG(0)) S (SIGOK,NEWDOSE)=1
- .I '$G(SPEED),PSONEW("DFLG")=1 S VALMSG="Renewal Request Cancelled!" W:$G(SPEED) !,"Renewal Request Cancelled!" Q:$G(PSONEW("DFLG"))
- .I +$G(PSONEW("ENT"))'>0 K DIRUT Q
- .D INS^PSODIR(.PSONEW),EN^PSOFSIG(.PSONEW),SINS^PSODIR(.PSONEW):$G(^PS(55,PSODFN,"LAN"))
- .S:'$G(SPEED)&(PSONEW("DFLG")=1) VALMSG="Renewal Request Cancelled!" W:$G(SPEED)&(PSONEW("DFLG")=1) !,"Renewal Request Cancelled!"
- .I $G(SPEED),'$G(PSONEW("DFLG")) D KV^PSOVER1 S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR,KV^PSOVER1 K X,Y
- I +$G(PSONEW("ENT"))'>0 G VER
- D STOP^PSORENW1 I +$G(PSEXDT) D S PSORENW("QFLG")=1
- .S Y=PSORENW("FILL DATE") X ^DD("DD") S VALMSG=Y_" fill date is past expiration date "
- .S Y=$P(PSEXDT,"^",2) X ^DD("DD") S VALMSG=VALMSG_Y_"."
- I '$$SCREEN^APSPMULT(+$G(PSORENW("DRUG IEN")),,1) S PSORENW("QFLG")=1,VALMSG="^Sorry, this drug is not currently available in this facility" Q ;IHS/MSC/JDS - 12/09/10 - MDF
- Q
- DSPL G:$G(PSONEW("ENT"))>0 DSP
- S PSONEW("ENT")=0 F I=0:0 S I=$O(^PSRX(PSONEW("OIRXN"),6,I)) Q:'I S DOSE=^PSRX(PSONEW("OIRXN"),6,I,0) D
- .S PSONEW("ENT")=PSONEW("ENT")+1,PSONEW("DOSE",PSONEW("ENT"))=$P(DOSE,"^")
- .S PSONEW("UNITS",PSONEW("ENT"))=$P(DOSE,"^",3),PSONEW("DOSE ORDERED",PSONEW("ENT"))=$P(DOSE,"^",2),PSONEW("ROUTE",PSONEW("ENT"))=$P(DOSE,"^",7)
- .S PSONEW("SCHEDULE",PSONEW("ENT"))=$P(DOSE,"^",8),PSONEW("DURATION",PSONEW("ENT"))=$P(DOSE,"^",5),PSONEW("CONJUNCTION",PSONEW("ENT"))=$P(DOSE,"^",6)
- .S PSONEW("NOUN",PSONEW("ENT"))=$P(DOSE,"^",4),PSONEW("VERB",PSONEW("ENT"))=$P(DOSE,"^",9)
- .I $G(^PSRX(PSONEW("OIRXN"),6,I,1))]"" S PSONEW("ODOSE",PSONEW("ENT"))=^PSRX(PSONEW("OIRXN"),6,I,1)
- .K DOSE
- DSP D ^PSOORUT2 K ^TMP("PSOPO",$J) S IEN=0
- D:$G(PSONEW("PENDING ORDER")) LMDISP^PSOORFI5(+PSONEW("PENDING ORDER"))
- D:$G(PKI1) L1^PSOPKIV1
- D DIN^PSONFI(PSODRUG("OI"),$S($G(PSODRUG("IEN")):PSODRUG("IEN"),1:""))
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Rx#: "_PSONEW("NRX #")
- I +$G(PSODRUG("OI")) D
- .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Orderable Item: "_$P(^PS(50.7,+$G(PSODRUG("OI")),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")_NFIO
- .S:NFIO["<DIN>" NFIO=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4)
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" "_$S($D(^PSDRUG("AQ",PSODRUG("IEN"))):" CMOP ",1:" ")_"Drug: "_PSODRUG("NAME")_NFID
- S:NFID["<DIN>" NFID=IEN_","_($L(^TMP("PSOPO",$J,IEN,0))-4)
- S:$G(PSONEW("TN"))]"" IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Trade Name: "_$G(PSONEW("TN"))
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Patient Status: "_$P(PSONEW("PTST NODE"),"^"),PSONEW("PATIENT STATUS")=$P(PSONEW("PTST NODE"),"^")
- S (PSOID,Y)=PSONEW("ISSUE DATE") X ^DD("DD") S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (1) Issue Date: "_Y
- S Y=PSONEW("FILL DATE") X ^DD("DD") S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (2) Fill Date: "_Y
- I PSONEW("ENT")=0 S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=$S($G(PSOREEDT):" (9)",1:" ")_" Dosage:" G PAT
- F I=1:1:PSONEW("ENT") D
- .I '$G(PSONEW("DOSE ORDERED",I)),$G(PSONEW("VERB",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Verb: "_$G(PSONEW("VERB",I))
- .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=$S($G(PSOREEDT)&(I'>1):" (9)",1:" ")_" Dosage: "_$S($E(PSONEW("DOSE",I),1)="."&($G(PSONEW("DOSE ORDERED",I))):"0",1:"")_PSONEW("DOSE",I)
- .S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_$S($G(PSONEW("UNITS",I))]"":" ("_$P(^PS(50.607,PSONEW("UNITS",I),0),"^")_")",1:"")
- .I $P($G(^PS(55,PSODFN,"LAN")),"^"),'$G(PSONEW("DOSE ORDERED",I)) D
- ..S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Oth. Lang. Dosage: "_$G(PSONEW("ODOSE",I))
- .I $G(PSONEW("DOSE ORDERED",I)),$G(PSONEW("VERB",I))]"" D
- ..S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Verb: "_$G(PSONEW("VERB",I))
- ..S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Dispense Units: "_$S($E($G(PSONEW("DOSE ORDERED",I)),1)=".":"0",1:"")_$G(PSONEW("DOSE ORDERED",I))
- ..S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Noun: "_$G(PSONEW("NOUN",I))
- .I $G(PSONEW("ROUTE",I)) S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Route: "_$P(^PS(51.2,PSONEW("ROUTE",I),0),"^")
- .S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Schedule: "_PSONEW("SCHEDULE",I)
- .I $G(PSONEW("DURATION",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" *Duration: "_$G(PSONEW("DURATION",I))
- .I $G(PSONEW("CONJUNCTION",I))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Conjunction: "_$S($G(PSONEW("CONJUNCTION",I))="A":"AND",$G(PSONEW("CONJUNCTION",I))="T":"THEN",$G(PSONEW("CONJUNCTION",I))="X":"EXCEPT",1:"")
- PAT S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=$S($G(PSOREEDT):" (10)",1:" ")_"Pat Instruction:" D INS2^PSOBKDED
- S RXN=PSONEW("OIRXN") D INST1^PSORENW
- ;I $O(PRC(0)) D PC1^PSOORNE5
- K RXN S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" SIG:"
- I $G(SIGOK),$O(SIG(0)) D K SG,MIG
- .F I=0:0 S I=$O(SIG(I)) Q:'I F SG=1:1:$L(SIG(I)) D
- ..S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(SIG(I)," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",21)=" "
- ..S:$P(SIG(I)," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(SIG(I)," ",SG)
- E D
- .S X=$S($G(PSONEW("SIG"))]"":PSONEW("SIG"),1:$P($G(^PSRX(PSONEW("OIRXN"),"SIG")),"^")) D SIGONE^PSOHELP S SIG=$E($G(INS1),2,250)
- .F SG=1:1:$L(SIG) S:$L(^TMP("PSOPO",$J,IEN,0)_" "_$P(SIG," ",SG))>80 IEN=IEN+1,$P(^TMP("PSOPO",$J,IEN,0)," ",21)=" " S:$P(SIG," ",SG)'="" ^TMP("PSOPO",$J,IEN,0)=$G(^TMP("PSOPO",$J,IEN,0))_" "_$P(SIG," ",SG)
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Days Supply: "_PSONEW("DAYS SUPPLY")_$S($L(PSONEW("DAYS SUPPLY"))=1:" ",1:"")
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" QTY"_$S($G(PSODRUG("UNIT"))]"":" ("_PSODRUG("UNIT")_")",1:" ( )")_": "_PSONEW("QTY")
- I $D(^PSDRUG("AQ",PSODRUG("IEN"))),$P($G(^PSDRUG(PSODRUG("IEN"),5)),"^")]"" D
- .S $P(RN," ",79)=" ",IEN=IEN+1
- .S ^TMP("PSOPO",$J,IEN,0)=" QTY DSP MSG: "_$P(^PSDRUG(PSODRUG("IEN"),5),"^")
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (3) # of Refills: "_PSONEW("# OF REFILLS")_$S($L(PSONEW("# OF REFILLS"))=1:" ",1:"")
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (4) Routing: "_$S($G(PSORENW("MAIL/WINDOW"))["W":"WINDOW",1:"MAIL")
- S:$G(PSONEW("METHOD OF PICK-UP"))]""&($P(PSOPAR,"^",12)) IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Method of Pickup: "_PSONEW("METHOD OF PICK-UP")
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (5) Clinic: "_$S($G(PSONEW("CLINIC")):$P(^SC(PSONEW("CLINIC"),0),"^"),1:"")
- S $P(RN," ",31)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (6) Provider: "_PSONEW("PROVIDER NAME")_$E(RN,$L(PSONEW("PROVIDER NAME"))+1,31) K RN
- I $G(PSONEW("COSIGNING PROVIDER"))]"" S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Cos-Provider: "_$P(^VA(200,PSONEW("COSIGNING PROVIDER"),0),"^")
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (7) Copies: "_$S($G(PSONEW("COPIES")):PSONEW("COPIES"),1:1)
- RMK S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" (8) Remarks: "_$S($G(PSONEW("REMARKS"))]"":PSONEW("REMARKS"),1:"")
- S $P(RN," ",35)=" ",IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Entry By: "_$P(^VA(200,DUZ,0),"^")_$E(RN,$L($P(^VA(200,DUZ,0),"^"))+1,35)
- ; 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: "_$$GET1^DIQ(52,PSONEW("OIRXN"),27)
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" AWP: "_$$GET1^DIQ(52,PSONEW("OIRXN"),9999999.06)_" Unit Cost: "_$$GET1^DIQ(52,PSONEW("OIRXN"),17) ; IHS/CIA/PLS - 01/15/04
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Triplicate #: "_$$GET1^DIQ(52,PSONEW("OIRXN"),9999999.14) ; 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(PSONEW("LOT #"))_" ExpDate: "_$$FMTE^XLFDT($G(PSONEW("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"))
- S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" "
- ; End IHS Fields
- I $G(PSOFDR) S ^TMP("PSOPO",$J,IEN,0)=" Entry By: "_$P(^VA(200,$P(OR0,"^",4),0),"^")_$E(RN,$L($P(^VA(200,$P(OR0,"^",4),0),"^"))+1,35)
- D NOW^%DTC S PSONEW("LOGIN DATE")=$S($P($G(OR0),"^",6):$P($G(OR0),"^",6),1:%) K %,X S Y=PSONEW("LOGIN DATE") X ^DD("DD")
- S ^TMP("PSOPO",$J,IEN,0)=^TMP("PSOPO",$J,IEN,0)_"Entry Date: "_$P(Y,"@")_" "_$P(Y,"@",2) K RN
- S (VALMCNT,PSOPF)=IEN
- Q
- 0 ; EP - IHS/CIA/PLS - 01/26/04 - Prompt IHS Fields
- D IHSFLDS^APSPDIR(.PSONEW) Q
- ;
- 1 D 1^PSOBKDED Q
- 2 D 2^PSOBKDED Q
- 3 D 9^PSOBKDED Q
- 4 D 12^PSOBKDED Q
- 5 D 5^PSOBKDED Q
- 6 D 4^PSOBKDED Q
- 7 D 11^PSOBKDED Q
- 8 D 13^PSOBKDED Q
- 9 W !!,"Drug: "_PSODRUG("NAME") S PSOORRNW=1 D DOSE1^PSOORED5(.PSONEW)
- I $G(PSONEW("DFLG")) S PSODIR("DFLG")=1,VALMBCK="Q" Q
- D SV Q
- 10 D INS^PSODIR(.PSONEW),SINS^PSODIR(.PSONEW) D SV Q
- SV D SV^PSOORNE5 Q
- PSOORNE4 ;BIR/SAB-display renew RXs from backdoor ;04-Jun-2013 12:51;DU
- +1 ;;7.0;OUTPATIENT PHARMACY;**11,27,32,36,46,75,96,103,99,117,131,1008,1009,1013,225,1015,1017**;DEC 1997;Build 40
- +2 ;^SC DBIA-10040;^PS(50.7-2223;^PS(50.606-2174;^PS(50.607-2221;^PS(51.2-2226;^PSDRUG-221;^PS(55-2228
- +3 ; Modified - IHS/CIA/PLS - 01/27/04 - Added display of IHS Fields
- +4 ; IHS/MSC/PLS - 03/13/08 - Added line RMK+10
- +5 ; 01/23/09 - Added line RMK+11
- +6 ; 12/09/10 - Added line VER+17
- +7 ; 10/31/11 - Added line PKI+3
- +8 ; 06/04/13 - Added Discharge Medication
- EN(PSONEW) NEW FLD,LST,VALMCNT
- EN1 KILL PSOQUIT
- IF $GET(PSONEW("ENT"))'>0
- Begin DoDot:1
- +1 SET PSOREEDT=1
- DO SV
- +2 KILL PSONEW("DOSE"),PSONEW("UNITS"),PSONEW("DOSE ORDERED"),PSONEW("ROUTE")
- +3 KILL PSONEW("SCHEDULE"),PSONEW("DURATION"),PSONEW("CONJUNCTION"),PSONEW("NOUN"),PSONEW("VERB"),PSOPRC,PSONEW("ODOSE")
- End DoDot:1
- IF $GET(PSORENW("POE"))=1
- SET PSOREEDT=1
- DO SV
- RDD DO DSPL
- DO ^PSOLMRN
- IF $GET(PKI1)=2
- DO DCP^PSOPKIV1
- IF $GET(PSORX("FN"))
- SET VALMBCK="Q"
- KILL PSOREEDT
- QUIT
- +1 IF '$GET(PSOQUIT)
- GOTO RDD
- +2 QUIT
- +3 ; IHS/CIA/PLS - 01/27/04 - Commented out next to extend range to include zero
- EDT ;D KV^PSOVER1 S DIR("A")="Select Field to Edit by number",DIR(0)="LO^1:"_$S($G(PSOREEDT):10,1:8)
- +1 DO KV^PSOVER1
- SET DIR("A")="Select Field to Edit by number"
- SET DIR(0)="LO^0:"_$SELECT($GET(PSOREEDT):10,1:8)
- +2 DO ^DIR
- IF $DATA(DTOUT)!($DATA(DUOUT))
- DO KV^PSOVER1
- SET VALMBCK=""
- QUIT
- EDTSEL SET PSOLM=1
- SET (PSONEW("DFLG"),PSONEW("FIELD"),PSONEW3)=0
- +1 ; IHS/CIA/PLS - 01/27/04 - Changed to $L to include zero value
- +2 ;I +Y S LST=Y D HLDHDR^PSOLMUTL S PSOEDT=1 D Q:$G(PSODIR("DFLG"))!($G(PSODIR("QFLG")))
- +3 IF $LENGTH(Y)
- SET LST=Y
- DO HLDHDR^PSOLMUTL
- SET PSOEDT=1
- Begin DoDot:1
- +4 FOR FLD=1:1:$LENGTH(LST,",")
- IF $PIECE(LST,",",FLD)']""
- QUIT
- DO @(+$PIECE(LST,",",FLD))
- IF $GET(PSODIR("DFLG"))!($GET(PSODIR("QFLG")))
- QUIT
- End DoDot:1
- IF $GET(PSODIR("DFLG"))!($GET(PSODIR("QFLG")))
- QUIT
- +5 IF '$TEST
- SET VALMBCK=""
- DO FULL^VALM1
- +6 QUIT
- ACP IF $GET(PKI1)=1
- DO REA^PSOPKIV1
- IF $GET(PSONEW("QFLG"))=1
- GOTO PKI
- +1 DO INST2^PSORENW
- SET PSOFROM1=1
- IF $DATA(^XUSEC("PSORPH",DUZ))!('$PIECE(PSOPAR,"^",2))
- DO VER
- +2 KILL PSOFROM1
- PKI IF $GET(PSONEW("QFLG"))
- SET POERR("DFLG")=1
- SET VALMBCK="R"
- KILL PSONEW2
- QUIT
- +1 IF PSONEW("ENT")>0
- IF $GET(NEWDOSE)
- KILL NEWDOSE
- GOTO EN1
- QUIT
- +2 SET PSORX("FN")=1
- DO EN^PSORN52(.PSONEW)
- +3 ;P1013 - prompt for POV
- DO EN^APSPPCC1(PSODFN,PSONEW("IRXN"))
- +4 DO RNPSOSD^PSOUTIL
- DO ACP1^PSOORNE6
- DO ^PSOBUILD
- SET VALMBCK="Q"
- +5 QUIT
- VER1(PSONEW) ;
- VER SET (PSONEW("DFLG"),PSONEW("QFLG"))=0
- IF PSONEW("ENT")=0
- Begin DoDot:1
- +1 SET (PSOREEDT,PSOORRNW)=1
- WRITE !!,"Dosing Instruction Missing!!",!
- +2 SET PSONEW("IRXN")=PSONEW("OIRXN")
- KILL VALMSG
- DO FULL^VALM1
- WRITE !,"Drug: "_PSODRUG("NAME")
- Begin DoDot:2
- +3 IF $ORDER(SIG(0))
- Begin DoDot:3
- +4 FOR I=1:1
- IF $GET(SIG(I))']""
- QUIT
- WRITE !,SIG(I)
- End DoDot:3
- QUIT
- +5 IF $PIECE($GET(^PSRX(PSONEW("OIRXN"),"SIG")),"^")]""
- SET X=$PIECE(^PSRX(PSONEW("OIRXN"),"SIG"),"^")
- DO SIGONE^PSOHELP
- WRITE !,$EXTRACT($GET(INS1),2,250)
- End DoDot:2
- +6 KILL DIRUT
- WRITE !
- DO DOSE^PSODIR(.PSONEW)
- IF $GET(PSONEW("DFLG"))
- QUIT
- DO EN^PSOFSIG(.PSONEW)
- +7 IF PSONEW("ENT")>0
- IF $ORDER(SIG(0))
- SET (SIGOK,NEWDOSE)=1
- +8 IF '$GET(SPEED)
- IF PSONEW("DFLG")=1
- SET VALMSG="Renewal Request Cancelled!"
- IF $GET(SPEED)
- WRITE !,"Renewal Request Cancelled!"
- IF $GET(PSONEW("DFLG"))
- QUIT
- +9 IF +$GET(PSONEW("ENT"))'>0
- KILL DIRUT
- QUIT
- +10 DO INS^PSODIR(.PSONEW)
- DO EN^PSOFSIG(.PSONEW)
- IF $GET(^PS(55,PSODFN,"LAN"))
- DO SINS^PSODIR(.PSONEW)
- +11 IF '$GET(SPEED)&(PSONEW("DFLG")=1)
- SET VALMSG="Renewal Request Cancelled!"
- IF $GET(SPEED)&(PSONEW("DFLG")=1)
- WRITE !,"Renewal Request Cancelled!"
- +12 IF $GET(SPEED)
- IF '$GET(PSONEW("DFLG"))
- DO KV^PSOVER1
- SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue"
- DO ^DIR
- DO KV^PSOVER1
- KILL X,Y
- End DoDot:1
- KILL PSOORRNW,PSOFROM1
- IF PSONEW("DFLG")=1
- SET (PSONEW("QFLG"),POERR("DFLG"))=1
- QUIT
- +13 IF +$GET(PSONEW("ENT"))'>0
- GOTO VER
- +14 DO STOP^PSORENW1
- IF +$GET(PSEXDT)
- Begin DoDot:1
- +15 SET Y=PSORENW("FILL DATE")
- XECUTE ^DD("DD")
- SET VALMSG=Y_" fill date is past expiration date "
- +16 SET Y=$PIECE(PSEXDT,"^",2)
- XECUTE ^DD("DD")
- SET VALMSG=VALMSG_Y_"."
- End DoDot:1
- SET PSORENW("QFLG")=1
- +17 ;IHS/MSC/JDS - 12/09/10 - MDF
- IF '$$SCREEN^APSPMULT(+$GET(PSORENW("DRUG IEN")),,1)
- SET PSORENW("QFLG")=1
- SET VALMSG="^Sorry, this drug is not currently available in this facility"
- QUIT
- +18 QUIT
- DSPL IF $GET(PSONEW("ENT"))>0
- GOTO DSP
- +1 SET PSONEW("ENT")=0
- FOR I=0:0
- SET I=$ORDER(^PSRX(PSONEW("OIRXN"),6,I))
- IF 'I
- QUIT
- SET DOSE=^PSRX(PSONEW("OIRXN"),6,I,0)
- Begin DoDot:1
- +2 SET PSONEW("ENT")=PSONEW("ENT")+1
- SET PSONEW("DOSE",PSONEW("ENT"))=$PIECE(DOSE,"^")
- +3 SET PSONEW("UNITS",PSONEW("ENT"))=$PIECE(DOSE,"^",3)
- SET PSONEW("DOSE ORDERED",PSONEW("ENT"))=$PIECE(DOSE,"^",2)
- SET PSONEW("ROUTE",PSONEW("ENT"))=$PIECE(DOSE,"^",7)
- +4 SET PSONEW("SCHEDULE",PSONEW("ENT"))=$PIECE(DOSE,"^",8)
- SET PSONEW("DURATION",PSONEW("ENT"))=$PIECE(DOSE,"^",5)
- SET PSONEW("CONJUNCTION",PSONEW("ENT"))=$PIECE(DOSE,"^",6)
- +5 SET PSONEW("NOUN",PSONEW("ENT"))=$PIECE(DOSE,"^",4)
- SET PSONEW("VERB",PSONEW("ENT"))=$PIECE(DOSE,"^",9)
- +6 IF $GET(^PSRX(PSONEW("OIRXN"),6,I,1))]""
- SET PSONEW("ODOSE",PSONEW("ENT"))=^PSRX(PSONEW("OIRXN"),6,I,1)
- +7 KILL DOSE
- End DoDot:1
- DSP DO ^PSOORUT2
- KILL ^TMP("PSOPO",$JOB)
- SET IEN=0
- +1 IF $GET(PSONEW("PENDING ORDER"))
- DO LMDISP^PSOORFI5(+PSONEW("PENDING ORDER"))
- +2 IF $GET(PKI1)
- DO L1^PSOPKIV1
- +3 DO DIN^PSONFI(PSODRUG("OI"),$SELECT($GET(PSODRUG("IEN")):PSODRUG("IEN"),1:""))
- +4 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Rx#: "_PSONEW("NRX #")
- +5 IF +$GET(PSODRUG("OI"))
- Begin DoDot:1
- +6 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Orderable Item: "_$PIECE(^PS(50.7,+$GET(PSODRUG("OI")),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")_NFIO
- +7 IF NFIO["<DIN>"
- SET NFIO=IEN_","_($LENGTH(^TMP("PSOPO",$JOB,IEN,0))-4)
- End DoDot:1
- +8 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" "_$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 $GET(PSONEW("TN"))]""
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Trade Name: "_$GET(PSONEW("TN"))
- +11 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Patient Status: "_$PIECE(PSONEW("PTST NODE"),"^")
- SET PSONEW("PATIENT STATUS")=$PIECE(PSONEW("PTST NODE"),"^")
- +12 SET (PSOID,Y)=PSONEW("ISSUE DATE")
- XECUTE ^DD("DD")
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (1) Issue Date: "_Y
- +13 SET Y=PSONEW("FILL DATE")
- XECUTE ^DD("DD")
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (2) Fill Date: "_Y
- +14 IF PSONEW("ENT")=0
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=$SELECT($GET(PSOREEDT):" (9)",1:" ")_" Dosage:"
- GOTO PAT
- +15 FOR I=1:1:PSONEW("ENT")
- Begin DoDot:1
- +16 IF '$GET(PSONEW("DOSE ORDERED",I))
- IF $GET(PSONEW("VERB",I))]""
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Verb: "_$GET(PSONEW("VERB",I))
- +17 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=$SELECT($GET(PSOREEDT)&(I'>1):" (9)",1:" ")_" Dosage: "_$SELECT($EXTRACT(PSONEW("DOSE",I),1)="."&($GET(PSONEW("DOSE ORDERED",I))):"0",1:"")_PSONEW("DOSE",I)
- +18 SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_$SELECT($GET(PSONEW("UNITS",I))]"":" ("_$PIECE(^PS(50.607,PSONEW("UNITS",I),0),"^")_")",1:"")
- +19 IF $PIECE($GET(^PS(55,PSODFN,"LAN")),"^")
- IF '$GET(PSONEW("DOSE ORDERED",I))
- Begin DoDot:2
- +20 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Oth. Lang. Dosage: "_$GET(PSONEW("ODOSE",I))
- End DoDot:2
- +21 IF $GET(PSONEW("DOSE ORDERED",I))
- IF $GET(PSONEW("VERB",I))]""
- Begin DoDot:2
- +22 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Verb: "_$GET(PSONEW("VERB",I))
- +23 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Dispense Units: "_$SELECT($EXTRACT($GET(PSONEW("DOSE ORDERED",I)),1)=".":"0",1:"")_$GET(PSONEW("DOSE ORDERED",I))
- +24 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Noun: "_$GET(PSONEW("NOUN",I))
- End DoDot:2
- +25 IF $GET(PSONEW("ROUTE",I))
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Route: "_$PIECE(^PS(51.2,PSONEW("ROUTE",I),0),"^")
- +26 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Schedule: "_PSONEW("SCHEDULE",I)
- +27 IF $GET(PSONEW("DURATION",I))]""
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" *Duration: "_$GET(PSONEW("DURATION",I))
- +28 IF $GET(PSONEW("CONJUNCTION",I))]""
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Conjunction: "_$SELECT($GET(PSONEW("CONJUNCTION",I))="A":"AND",$GET(PSONEW("CONJUNCTION",I))="T":"THEN",$GET(PSONEW("CONJUNCTION",I))="X":"EXCEPT",1:"")
- End DoDot:1
- PAT SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=$SELECT($GET(PSOREEDT):" (10)",1:" ")_"Pat Instruction:"
- DO INS2^PSOBKDED
- +1 SET RXN=PSONEW("OIRXN")
- DO INST1^PSORENW
- +2 ;I $O(PRC(0)) D PC1^PSOORNE5
- +3 KILL RXN
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" SIG:"
- +4 IF $GET(SIGOK)
- IF $ORDER(SIG(0))
- Begin DoDot:1
- +5 FOR I=0:0
- SET I=$ORDER(SIG(I))
- IF 'I
- QUIT
- FOR SG=1:1:$LENGTH(SIG(I))
- Begin DoDot:2
- +6 IF $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(SIG(I)," ",SG))>80
- SET IEN=IEN+1
- SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",21)=" "
- +7 IF $PIECE(SIG(I)," ",SG)'=""
- SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE(SIG(I)," ",SG)
- End DoDot:2
- End DoDot:1
- KILL SG,MIG
- +8 IF '$TEST
- Begin DoDot:1
- +9 SET X=$SELECT($GET(PSONEW("SIG"))]"":PSONEW("SIG"),1:$PIECE($GET(^PSRX(PSONEW("OIRXN"),"SIG")),"^"))
- DO SIGONE^PSOHELP
- SET SIG=$EXTRACT($GET(INS1),2,250)
- +10 FOR SG=1:1:$LENGTH(SIG)
- IF $LENGTH(^TMP("PSOPO",$JOB,IEN,0)_" "_$PIECE(SIG," ",SG))>80
- SET IEN=IEN+1
- SET $PIECE(^TMP("PSOPO",$JOB,IEN,0)," ",21)=" "
- IF $PIECE(SIG," ",SG)'=""
- SET ^TMP("PSOPO",$JOB,IEN,0)=$GET(^TMP("PSOPO",$JOB,IEN,0))_" "_$PIECE(SIG," ",SG)
- End DoDot:1
- +11 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Days Supply: "_PSONEW("DAYS SUPPLY")_$SELECT($LENGTH(PSONEW("DAYS SUPPLY"))=1:" ",1:"")
- +12 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" QTY"_$SELECT($GET(PSODRUG("UNIT"))]"":" ("_PSODRUG("UNIT")_")",1:" ( )")_": "_PSONEW("QTY")
- +13 IF $DATA(^PSDRUG("AQ",PSODRUG("IEN")))
- IF $PIECE($GET(^PSDRUG(PSODRUG("IEN"),5)),"^")]""
- Begin DoDot:1
- +14 SET $PIECE(RN," ",79)=" "
- SET IEN=IEN+1
- +15 SET ^TMP("PSOPO",$JOB,IEN,0)=" QTY DSP MSG: "_$PIECE(^PSDRUG(PSODRUG("IEN"),5),"^")
- End DoDot:1
- +16 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (3) # of Refills: "_PSONEW("# OF REFILLS")_$SELECT($LENGTH(PSONEW("# OF REFILLS"))=1:" ",1:"")
- +17 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (4) Routing: "_$SELECT($GET(PSORENW("MAIL/WINDOW"))["W":"WINDOW",1:"MAIL")
- +18 IF $GET(PSONEW("METHOD OF PICK-UP"))]""&($PIECE(PSOPAR,"^",12))
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Method of Pickup: "_PSONEW("METHOD OF PICK-UP")
- +19 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (5) Clinic: "_$SELECT($GET(PSONEW("CLINIC")):$PIECE(^SC(PSONEW("CLINIC"),0),"^"),1:"")
- +20 SET $PIECE(RN," ",31)=" "
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (6) Provider: "_PSONEW("PROVIDER NAME")_$EXTRACT(RN,$LENGTH(PSONEW("PROVIDER NAME"))+1,31)
- KILL RN
- +21 IF $GET(PSONEW("COSIGNING PROVIDER"))]""
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Cos-Provider: "_$PIECE(^VA(200,PSONEW("COSIGNING PROVIDER"),0),"^")
- +22 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (7) Copies: "_$SELECT($GET(PSONEW("COPIES")):PSONEW("COPIES"),1:1)
- RMK SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" (8) Remarks: "_$SELECT($GET(PSONEW("REMARKS"))]"":PSONEW("REMARKS"),1:"")
- +1 SET $PIECE(RN," ",35)=" "
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Entry By: "_$PIECE(^VA(200,DUZ,0),"^")_$EXTRACT(RN,$LENGTH($PIECE(^VA(200,DUZ,0),"^"))+1,35)
- +2 ; IHS/CIA/PLS - 01/26/04 - Add IHS Fields to display
- +3 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)="Enter a zero (0) to edit IHS specific fields."
- +4 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" NDC: "_$$GET1^DIQ(52,PSONEW("OIRXN"),27)
- +5 ; IHS/CIA/PLS - 01/15/04
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" AWP: "_$$GET1^DIQ(52,PSONEW("OIRXN"),9999999.06)_" Unit Cost: "_$$GET1^DIQ(52,PSONEW("OIRXN"),17)
- +6 ; IHS/CIA/PLS - 01/15/04
- SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Triplicate #: "_$$GET1^DIQ(52,PSONEW("OIRXN"),9999999.14)
- +7 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Bill Status: "_$$EXTERNAL^DILFD(52,9999999.07,,$GET(PSONEW("BST")))
- +8 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Manufacturer: "_$GET(PSONEW("MANUFACTURER"))_" Lot #: "_$GET(PSONEW("LOT #"))_" ExpDate: "_$$FMTE^XLFDT($GET(PSONEW("EXPIRATION DATE")))
- +9 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Chronic Med: "_$$EXTERNAL^DILFD(52,9999999.02,,$GET(PSONEW("CM")))
- +10 ;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")))
- +11 ; 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")))
- +12 ; 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")))
- +13 ;S IEN=IEN+1,^TMP("PSOPO",$J,IEN,0)=" Insurer: "_$G(PSONEW("INSURER"))
- +14 SET IEN=IEN+1
- SET ^TMP("PSOPO",$JOB,IEN,0)=" "
- +15 ; End IHS Fields
- +16 IF $GET(PSOFDR)
- SET ^TMP("PSOPO",$JOB,IEN,0)=" Entry By: "_$PIECE(^VA(200,$PIECE(OR0,"^",4),0),"^")_$EXTRACT(RN,$LENGTH($PIECE(^VA(200,$PIECE(OR0,"^",4),0),"^"))+1,35)
- +17 DO NOW^%DTC
- SET PSONEW("LOGIN DATE")=$SELECT($PIECE($GET(OR0),"^",6):$PIECE($GET(OR0),"^",6),1:%)
- KILL %,X
- SET Y=PSONEW("LOGIN DATE")
- XECUTE ^DD("DD")
- +18 SET ^TMP("PSOPO",$JOB,IEN,0)=^TMP("PSOPO",$JOB,IEN,0)_"Entry Date: "_$PIECE(Y,"@")_" "_$PIECE(Y,"@",2)
- KILL RN
- +19 SET (VALMCNT,PSOPF)=IEN
- +20 QUIT
- 0 ; EP - IHS/CIA/PLS - 01/26/04 - Prompt IHS Fields
- +1 DO IHSFLDS^APSPDIR(.PSONEW)
- QUIT
- +2 ;
- 1 DO 1^PSOBKDED
- QUIT
- 2 DO 2^PSOBKDED
- QUIT
- 3 DO 9^PSOBKDED
- QUIT
- 4 DO 12^PSOBKDED
- QUIT
- 5 DO 5^PSOBKDED
- QUIT
- 6 DO 4^PSOBKDED
- QUIT
- 7 DO 11^PSOBKDED
- QUIT
- 8 DO 13^PSOBKDED
- QUIT
- 9 WRITE !!,"Drug: "_PSODRUG("NAME")
- SET PSOORRNW=1
- DO DOSE1^PSOORED5(.PSONEW)
- +1 IF $GET(PSONEW("DFLG"))
- SET PSODIR("DFLG")=1
- SET VALMBCK="Q"
- QUIT
- +2 DO SV
- QUIT
- 10 DO INS^PSODIR(.PSONEW)
- DO SINS^PSODIR(.PSONEW)
- DO SV
- QUIT
- SV DO SV^PSOORNE5
- QUIT
