PSODDPR3 ;BIR/SAB - display NVA enhanced order checks ;10/04/06 3:38pm
;;7.0;OUTPATIENT PHARMACY;**251,375,379,372,651**;DEC 1997;Build 30
;Reference ^PSDRUG supported by DBIA 221
;Reference ^PS(55 supported by DBIA 2228
;Reference ^PS(50.7 is supported by DBIA 2223
;Reference ^PS(50.606 supported by DBIA 2174
NVA S DUPRX0=^PS(55,PSODFN,"NVA",$P(ON,";",2),0) N NVAQ
S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) ! I '$P(DUPRX0,"^",2) W:'$G(PSODUPF) $J("Non-VA Med: ",20)_$P(^PS(50.7,$P(DUPRX0,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
E S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) $J("Non-VA Med: ",20)_$P(^PSDRUG($P(DUPRX0,"^",2),0),"^")
;W " (Active)"
S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Dosage: ",20)_$S($P(DUPRX0,"^",3)]"":$P(DUPRX0,"^",3),1:"<NOT ENTERED>"),$J("Schedule: ",20)_$S($P(DUPRX0,"^",5)]"":$P(DUPRX0,"^",5),1:"<NOT ENTERED>")
K DSC,DSPL,CAN,DA,DIR,DNM,DUPRX0,ISSD,J,LSTFL,MSG,PHYS,PSOCLC,REA,RFLS,RX0,RX2,RXN,RXREC,ST,Y,ZZ,ACT,PSOCLOZ,PSOLR,PSOLDT,PSOCD,SIG
K LST,THER,THERO,^UTILITY($J),DGI,SER,SEV,SERS,BSIG,I,NODDERR,NODTERR,PDRG,DRGI,IZ
K ^UTILITY($J,"W"),X,ZX,DIWL,DIWR,DIWF
Q
MON ;print monograph
Q:$G(PSODLQT)
N MONQ,DRGINFO,PVAGDRG,PVAGDRG,VAGDRG,MDRGCNT,MONSEV,PSOMON1,MONTITLE,FDBSEV,SMONTI,MONQ K DIR S DIR(0)="Y",DIR("A")="Display Interaction Monograph",DIR("B")="No" D ^DIR
S:($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) PSODLQT=1,PSORX("DFLG")=1 W:$G(PSODLQT) !,PSONULN,! K DIR,DTOUT,DUOUT,DIRUT Q:'Y!($G(PSODLQT))
;ADD OUTPUT DEVICE
K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS
I POP W !,"NOTHING PRINTED" Q
E W !
I $D(IO("Q")) D Q
.S ZTRTN="QUE^PSODDPR3",ZTDESC="Monograph Report of Drug Interactions",ZTSAVE("PSONULN")="",ZTSAVE("SEV")="",ZTSAVE("LIST")=""
.S ZTSAVE("^TMP($J,LIST,""OUT"",""DRUGDRUG"",SV,DRG,ON,")="",ZTSAVE("ON")="",ZTSAVE("DRG")="",ZTSAVE("CT")="",ZTSAVE("PDRG")=""
.S ZTSAVE("^TMP($J,""OUT"",""REMOTE"",")="",ZTSAVE("SV")=""
.D ^%ZTLOAD,^%ZISC W !,"Monograph Queued to Print!",!
.S:$D(ZTQUEUED) ZTREQ="Q"
D QUE,^%ZISC
I $E(IOST)="C",'$G(PSOMONQ) K DIR S DIR(0)="E",DIR("?")="Press Return to continue",DIR("A")="Press Return to continue" D ^DIR W @IOF S:($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) PSODLQT=1,PSORX("DFLG")=1 K DIR,DTOUT,DUOUT,DIRUT
K DIR,DTOUT,DUOUT,^UTILITY($J),DIWL,DIWR,DIWF,X,QX,PMON,RDI,^TMP($J,LIST,"PMON"),RMRX,PSOMON1,PSOMONQ,MONQ,FDBSEV,MONTITLE,SMONTI
Q
;
QUE S (CT,PMON,MDRGCNT)=0 K ^TMP($J,LIST,"PMON")
U IO
;sort to attain an array of FDBSEV by drug and monograph title. Note that the PMON array is already sorted by Vista Severity
F S CT=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT)) Q:'CT D
. I $D(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",5,0)) S MONSEV="",MONSEV=^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",5,0) D
..S FDBSEV=$P($P(MONSEV,"SEVERITY LEVEL: ",2),"-",1),FDBSEV=$TR(FDBSEV," ","") S:'$G(FDBSEV) FDBSEV=999999999
..S MONTITLE="",MONTITLE=$G(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",3,0)),MONTITLE=$P(MONTITLE,"MONOGRAPH TITLE: ",2)
..S:MONTITLE="" MONTITLE="Zz No title given"
..S PSOMON1(DRG,MONTITLE,FDBSEV)=""
Q:$G(PSODLQT)
;sort "PMON" nodes by drug and FDB severity then print monograph; MDRGCNT = monograph drug count - sequential number counting monographs per drug. If multiple monographs fro same drug allows display of each.
;; PMON = counter of # of lines in the monograph to be displayed; FDBSEV = FDB severity for each monograph within the Vista severity
F S CT=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT)) Q:'CT!$G(PSODLQT) D S PMON=PMON+1,^TMP($J,LIST,"PMON",PMON,0)=""
.S DRGINFO=^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT),PDRGIEN=$P(DRGINFO,"^",2),DRGIEN=$P(DRGINFO,"^",3)
.S PVAGDRG=$$GET1^DIQ(50,PDRGIEN,20,"E"),VAGDRG=$$GET1^DIQ(50,DRGIEN,20,"E"),MDRGCNT=MDRGCNT+1
.I PVAGDRG="" S PVAGDRG=$P(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT),"^",4)
.I VAGDRG="" S VAGDRG=DRG
.S SMONTI=$G(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",3,0)),SMONTI=$P(SMONTI,"MONOGRAPH TITLE: ",2)
.I $D(PSOMON1(DRG,SMONTI)) S FDBSEV="",FDBSEV=$O(PSOMON1(DRG,SMONTI,FDBSEV))
.S PMON=PMON+1,^TMP($J,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0)=PSONULN
.S PMON=PMON+1,^TMP($J,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0)="Professional Monograph",PMON=PMON+1
.S ^TMP($J,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0)="Drug Interaction with "_PVAGDRG_" and "_VAGDRG,PMON=PMON+1,^TMP($J,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0)=""
.F QX=0:0 S QX=$O(^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",QX)) Q:'QX D FPMON
Q:'$O(^TMP($J,LIST,"PMON",0))!$G(PSODLQT)
K DIR,DTOUT,DUOUT,MONQ U IO W @IOF
I $P(ON,";")="R" S RMRX=$P(^TMP($J,LIST,"OUT","REMOTE",$P(ON,";",2)),"^",5)
;display monograph detailed information
F FDBSEV=0:0 S FDBSEV=$O(^TMP($J,LIST,"PMON",FDBSEV)) Q:FDBSEV=""!($G(MONQ)) F QXX=0:0 S QXX=$O(^TMP($J,LIST,"PMON",FDBSEV,QXX)) Q:QXX=""!($G(MONQ)) S PSOMONQ=0 D
.F QX=0:0 S QX=$O(^TMP($J,LIST,"PMON",FDBSEV,QXX,QX)) Q:'QX!($G(PSOMONQ)=1)!($G(MONQ)) W !,^TMP($J,LIST,"PMON",FDBSEV,QXX,QX,0) I $Y+3>IOSL D
..I $E(IOST)="C",($Y+3)>IOSL S PSOMONQ=$$PAUSE1()
..I PSOMONQ=1 W @IOF Q
..I PSOMONQ=2 S MONQ=1
..W @IOF,!
Q
;
PAUSE1() ;Allow "^"
;Return 0 if X="" ;Return 1 if X="^" ;Return 2 if Not null or "^"
NEW DIR,DIRUT,DUOUT,X
W ! K DIR S DIR("A")="Press RETURN to continue, ""^"" to display the next Monograph or ""^^"" to Exit"
S DIR("?")="Enter ""^"" to go to next Monograph, ""^^"" to exit the Monograph display."
S DIR(0)="FOU^^K:(X'="""")!(X'[""^"") X"
D ^DIR
I X="" Q 0
I X="^" Q 1
Q 2
RDI ;RDI orders
Q:'$D(^TMP($J,LIST,"OUT","REMOTE",$P(ON,";",2)))
S RXREC=^TMP($J,LIST,"OUT","REMOTE",$P(ON,";",2))
S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("LOCATION: ",20)_$P(RXREC,"^")_" Remote Rx: "_$P(RXREC,"^",5)
S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Drug: ",20)_$P(RXREC,"^",3)_" ("_$P(RXREC,"^",4)_")"
D FSIG(.FSIG)
S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("SIG: ",20) F I=1:1 Q:'$D(FSIG(I)) W:'$G(PSODUPF) ?20,FSIG(I) I $O(FSIG(I)) W:'$G(PSODUPF) !
I $G(QTHER) S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("QTY: ",20)_$P(RXREC,"^",8),?40,$J("Days Supply: ",24)_$P(RXREC,"^",7)
S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Last Filled On: ",20)_$P(RXREC,"^",6)
S ^TMP($J,"PSONRVADD",RXREC,0)=1
K RXREC,I,FSIG
Q
FSIG(FSIG) ;Format sig from remote site ;returned in the FSIG array
K FSIG N FFF,NNN,CNT,FVAR,FVAR1,FLIM,HSIG,II,I
F I=0:1 Q:'$D(^TMP($J,LIST,"OUT","REMOTE",$P(ON,";",2),"SIG",I)) S HSIG(I+1)=^(I)
FSTART S (FVAR,FVAR1)="",II=1
F FFF=0:0 S FFF=$O(HSIG(FFF)) Q:'FFF S CNT=0 F NNN=1:1:$L(HSIG(FFF)) I $E(HSIG(FFF),NNN)=" "!($L(HSIG(FFF))=NNN) S CNT=CNT+1 D I $L(FVAR)>50 S FSIG(II)=FLIM_" ",II=II+1,FVAR=FVAR1
.S FVAR1=$P(HSIG(FFF)," ",(CNT))
.S FLIM=FVAR
.S FVAR=$S(FVAR="":FVAR1,1:FVAR_" "_FVAR1)
I $G(FVAR)'="" S FSIG(II)=FVAR
I $G(FSIG(1))=""!($G(FSIG(1))=" ") S FSIG(1)=$G(FSIG(2)) K FSIG(2)
FQUIT ;
Q
DCOR ;dc duplicate therapy
Q:'$D(^XUSEC("PSORPH",DUZ))!$G(PSODLQT)
S MSG="Discontinued During "_$S('$G(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Therapy"
S ACT="Duplicate Therapy Discontinued while "_$S('$G(PSONV):"entering",1:"verifying")_" new RX"
N DCN,DCRD,LST S THERO=0 F I=0:0 S I=$O(^TMP($J,"PSODCOR",I)) Q:'I S THERO=THERO+1
I THERO=1 D Q
.K DIR S DIR(0)="Y",THER(1)=^TMP($J,"PSODCOR",1)
.S DIR("A")="Discontinue "_$S($P(THER(1),"^")="P":"Pending Order "_$P(THER(1),"^",4),1:"Rx #"_$P(^PSRX($P(THER(1),"^",2),0),"^")_" "_$P(THER(1),"^",4))_" Y/N "
.D ^DIR S:($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) PSODLQT=1,PSORX("DFLG")=1 Q:$G(PSODLQT) K DIR,DIRUT I 'Y K DIR,THER,THERO,X,Y Q
.S ^TMP("PSORXDC",$J,$P(THER(1),"^",2),0)=$P(THER(1),"^")_"^"_$P(THER(1),"^",2)_"^"_MSG
.I $P(THER(1),"^")=52 S ^TMP("PSORXDC",$J,$P(THER(1),"^",2),0)=^TMP("PSORXDC",$J,$P(THER(1),"^",2),0)_"^C^"_ACT_"^"_$P(THER(1),"^",3)_"^"_$P(THER(1),"^",4),PSONOOR="D"
.S $P(^TMP("PSORXDC",$J,$P(THER(1),"^",2),0),"^",10)=1
.W !! K ^UTILITY($J,"W") S DIWL=1,DIWR=75,DIWF=""
.S X="Duplicate Therapy "_$S($P(THER(1),"^")="P":"Pending Order ",1:"Rx #"_$P(^PSRX($P(THER(1),"^",2),0),"^"))_" "_$P(THER(1),"^",4)_" will be discontinued after the acceptance of the new order." D ^DIWP
.F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W !,^UTILITY($J,"W",1,ZX,0)
.K ^UTILITY($J,"W"),X,DIWL,DIWR,DIWF W ! H 2
K DIR S DIR(0)="Y",DIR("A")="Discontinue Orders Y/N ",DIR("B")="No" D ^DIR
S:($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) PSODLQT=1,PSORX("DFLG")=1 Q:$G(PSODLQT)
I 'Y K DIR,X,Y Q
K DIR S DIR(0)="LO^1:"_THERO
F I=1:1:THERO S DIR("A",I)=I_". "_$S($P(^TMP($J,"PSODCOR",I),"^")="P":"Pending Order "_$P(^TMP($J,"PSODCOR",I),"^",4),1:"Rx #"_$P(^PSRX($P(^TMP($J,"PSODCOR",I),"^",2),0),"^")_" "_$P(^TMP($J,"PSODCOR",I),"^",4))
S DIR("A")="Select Order(s)" D ^DIR S:($D(DTOUT))!($D(DUOUT))!($G(DIRUT)) PSODLQT=1,PSORX("DFLG")=1 Q:$G(PSODLQT) K DIR,DIRUT I 'Y K THER,THERO Q
S LST=Y(0) F DCRD=1:1:$L(LST,",") Q:$P(LST,",",DCRD)']""!$G(PSODLQT) D
.S DCN=$P(LST,",",DCRD),THER(DCN)=^TMP($J,"PSODCOR",DCN)
.S ^TMP("PSORXDC",$J,$P(THER(DCN),"^",2),0)=$P(THER(DCN),"^")_"^"_$P(THER(DCN),"^",2)_"^"_MSG
.I $P(THER(DCN),"^")=52 S ^TMP("PSORXDC",$J,$P(THER(DCN),"^",2),0)=^TMP("PSORXDC",$J,$P(THER(DCN),"^",2),0)_"^C^"_ACT_"^"_$P(THER(DCN),"^",3)_"^"_$P(THER(DCN),"^",4),PSONOOR="D"
.S $P(^TMP("PSORXDC",$J,$P(THER(DCN),"^",2),0),"^",10)=1
.W ! K ^UTILITY($J,"W") S DIWL=1,DIWR=75,DIWF=""
.S X="Duplicate Therapy "_$S($P(THER(DCN),"^")="P":"Pending Order "_$P(THER(DCN),"^",4),1:"Rx #"_$P(^PSRX($P(THER(DCN),"^",2),0),"^")_" "_$P(THER(DCN),"^",4))_" will be discontinued after the acceptance of the new order." D ^DIWP
.F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX W !,^UTILITY($J,"W",1,ZX,0)
.K ^UTILITY($J,"W"),X,DIWL,DIWR,DIWF H 2
W ! K X,Y,THER,THERO,MSG,ACT,I,DIR
Q
FPMON ;displays instruction and/or comments
S PMON=PMON+1,MG=^TMP($J,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",QX,0)
I MG="" S ^TMP($J,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0)="",PMON=PMON+1 Q
I $L(MG)>70 F SG=1:1:$L(MG," ") S:$L(($G(^TMP($J,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0)))_" "_$P(MG," ",SG))>80 PMON=PMON+1 S ^TMP($J,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0)=$G(^TMP($J,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0))_$P(MG," ",SG)_" "
E S PMON=PMON+1,^TMP($J,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0)=$G(^TMP($J,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0))_MG
K MG,SG
Q
VAGEN(PSODD) ;Return the VA GENERIC name
;PSODD - IEN (file #50)
N PSOIEN I '+$G(PSODD) Q ""
S PSOIEN=+$G(^PSDRUG(PSODD,"ND")) D ZERO^PSN50P6(PSOIEN,,,,"PSOVAG")
S PSOVAG=$G(^TMP($J,"PSOVAG",PSOIEN,.01)) K ^TMP($J,"PSOVAG")
Q PSOVAG
INST ;displays instruction and/or comments
S INST=0 F S INST=$O(^PS(52.41,RXREC,TY,INST)) Q:'INST S MIG=^PS(52.41,RXREC,TY,INST,0) D
.W !,$S(TY=2:" "_$S($$ERXIEN^PSOERXUT(RXREC_"P"):"eRx",1:" ")_" Instructions: ",TY=3:" Provider Comments: ",1:"")
.F SG=1:1:$L(MIG," ") D HD^PSODDPR2() Q:$G(PSODLQT) W:$X+$L($P(MIG," ",SG)_" ")>IOM @$S(TY=3:"!?14",1:"!?19") W $P(MIG," ",SG)_" "
K INST,TY,MIG,SG
Q
CLASSES ;display therapeutic duplications classes (called from PSODDPR5 too)
I '$G(PSODUPF) D
.I '$G(PSODUPCT)&('$G(PSODUPC("CLASS"))) D HD^PSODDPR2() Q
.I ($G(PSODUPCT)+PSODUPC("CLASS"))>22 D HD^PSODDPR2(15) S PSODUPCT=0
Q:$G(PSODLQT)
K ^UTILITY($J,"W") S DIWL=1,DIWR=75,DIWF="",ZCT=0 S:$G(PSODUPF) PSODUPC("CLASS")=PSODUPC("CLASS")+1 W:'$G(PSODUPF) !
S X="Class(es) Involved in Therapeutic Duplication(s): " D ^DIWP
S (ZCT,ZZCT,ZZZCT)=0 F S ZZCT=$O(^TMP($J,LIST,"OUT","THERAPY",ZZCT)) Q:'ZZCT S ZCT=0 F S ZCT=$O(^TMP($J,LIST,"OUT","THERAPY",ZZCT,ZCT)) Q:'ZCT D
. S X=^TMP($J,LIST,"OUT","THERAPY",ZZCT,ZCT,"CLASS")
. S X=^TMP($J,LIST,"OUT","THERAPY",ZZCT,ZCT,"CLASS")_$S($O(^TMP($J,LIST,"OUT","THERAPY",ZZCT))!($O(^TMP($J,LIST,"OUT","THERAPY",ZZCT,ZCT))):", ",1:" ")
. D ^DIWP
F ZX=0:0 S ZX=$O(^UTILITY($J,"W",1,ZX)) Q:'ZX S:$G(PSODUPF) PSODUPC("CLASS")=PSODUPC("CLASS")+1 W:'$G(PSODUPF) !,^UTILITY($J,"W",1,ZX,0)
K ^UTILITY($J,"W"),X,CLASS,DIWL,DIWR,DIWF,ZX,DRG,ZCT,ZZCT,ZZZCT
S:$G(PSODUPF) PSODUPC("CLASS")=PSODUPC("CLASS")+1 W:'$G(PSODUPF) !,PSONULN1,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODDPR3 12274 printed Apr 09, 2024@21:30:43 Page 2
PSODDPR3 ;BIR/SAB - display NVA enhanced order checks ;10/04/06 3:38pm
+1 ;;7.0;OUTPATIENT PHARMACY;**251,375,379,372,651**;DEC 1997;Build 30
+2 ;Reference ^PSDRUG supported by DBIA 221
+3 ;Reference ^PS(55 supported by DBIA 2228
+4 ;Reference ^PS(50.7 is supported by DBIA 2223
+5 ;Reference ^PS(50.606 supported by DBIA 2174
NVA SET DUPRX0=^PS(55,PSODFN,"NVA",$PIECE(ON,";",2),0)
NEW NVAQ
+1 if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !
IF '$PIECE(DUPRX0,"^",2)
if '$GET(PSODUPF)
WRITE $JUSTIFY("Non-VA Med: ",20)_$PIECE(^PS(50.7,$PIECE(DUPRX0,"^"),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")
+2 IF '$TEST
if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE $JUSTIFY("Non-VA Med: ",20)_$PIECE(^PSDRUG($PIECE(DUPRX0,"^",2),0),"^")
+3 ;W " (Active)"
+4 if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY("Dosage: ",20)_$SELECT($PIECE(DUPRX0,"^",3)]"":$PIECE(DUPRX0,"^",3),1:"<NOT ENTERED>"),$JUSTIFY("Schedule: ",20)_$SELECT($PIECE(DUPRX0,"^",5)]"":$PIECE(DUPRX0,"^",5),1:"<NOT ENTERED>")
+5 KILL DSC,DSPL,CAN,DA,DIR,DNM,DUPRX0,ISSD,J,LSTFL,MSG,PHYS,PSOCLC,REA,RFLS,RX0,RX2,RXN,RXREC,ST,Y,ZZ,ACT,PSOCLOZ,PSOLR,PSOLDT,PSOCD,SIG
+6 KILL LST,THER,THERO,^UTILITY($JOB),DGI,SER,SEV,SERS,BSIG,I,NODDERR,NODTERR,PDRG,DRGI,IZ
+7 KILL ^UTILITY($JOB,"W"),X,ZX,DIWL,DIWR,DIWF
+8 QUIT
MON ;print monograph
+1 if $GET(PSODLQT)
QUIT
+2 NEW MONQ,DRGINFO,PVAGDRG,PVAGDRG,VAGDRG,MDRGCNT,MONSEV,PSOMON1,MONTITLE,FDBSEV,SMONTI,MONQ
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Display Interaction Monograph"
SET DIR("B")="No"
DO ^DIR
+3 if ($DATA(DTOUT))!($DATA(DUOUT))!($GET(DIRUT))
SET PSODLQT=1
SET PSORX("DFLG")=1
if $GET(PSODLQT)
WRITE !,PSONULN,!
KILL DIR,DTOUT,DUOUT,DIRUT
if 'Y!($GET(PSODLQT))
QUIT
+4 ;ADD OUTPUT DEVICE
+5 KILL IOP,%ZIS,POP
SET %ZIS="QM"
DO ^%ZIS
+6 IF POP
WRITE !,"NOTHING PRINTED"
QUIT
+7 IF '$TEST
WRITE !
+8 IF $DATA(IO("Q"))
Begin DoDot:1
+9 SET ZTRTN="QUE^PSODDPR3"
SET ZTDESC="Monograph Report of Drug Interactions"
SET ZTSAVE("PSONULN")=""
SET ZTSAVE("SEV")=""
SET ZTSAVE("LIST")=""
+10 SET ZTSAVE("^TMP($J,LIST,""OUT"",""DRUGDRUG"",SV,DRG,ON,")=""
SET ZTSAVE("ON")=""
SET ZTSAVE("DRG")=""
SET ZTSAVE("CT")=""
SET ZTSAVE("PDRG")=""
+11 SET ZTSAVE("^TMP($J,""OUT"",""REMOTE"",")=""
SET ZTSAVE("SV")=""
+12 DO ^%ZTLOAD
DO ^%ZISC
WRITE !,"Monograph Queued to Print!",!
+13 if $DATA(ZTQUEUED)
SET ZTREQ="Q"
End DoDot:1
QUIT
+14 DO QUE
DO ^%ZISC
+15 IF $EXTRACT(IOST)="C"
IF '$GET(PSOMONQ)
KILL DIR
SET DIR(0)="E"
SET DIR("?")="Press Return to continue"
SET DIR("A")="Press Return to continue"
DO ^DIR
WRITE @IOF
if ($DATA(DTOUT))!($DATA(DUOUT))!($GET(DIRUT))
SET PSODLQT=1
SET PSORX("DFLG")=1
KILL DIR,DTOUT,DUOUT,DIRUT
+16 KILL DIR,DTOUT,DUOUT,^UTILITY($JOB),DIWL,DIWR,DIWF,X,QX,PMON,RDI,^TMP($JOB,LIST,"PMON"),RMRX,PSOMON1,PSOMONQ,MONQ,FDBSEV,MONTITLE,SMONTI
+17 QUIT
+18 ;
QUE SET (CT,PMON,MDRGCNT)=0
KILL ^TMP($JOB,LIST,"PMON")
+1 USE IO
+2 ;sort to attain an array of FDBSEV by drug and monograph title. Note that the PMON array is already sorted by Vista Severity
+3 FOR
SET CT=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT))
if 'CT
QUIT
Begin DoDot:1
+4 IF $DATA(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",5,0))
SET MONSEV=""
SET MONSEV=^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",5,0)
Begin DoDot:2
+5 SET FDBSEV=$PIECE($PIECE(MONSEV,"SEVERITY LEVEL: ",2),"-",1)
SET FDBSEV=$TRANSLATE(FDBSEV," ","")
if '$GET(FDBSEV)
SET FDBSEV=999999999
+6 SET MONTITLE=""
SET MONTITLE=$GET(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",3,0))
SET MONTITLE=$PIECE(MONTITLE,"MONOGRAPH TITLE: ",2)
+7 if MONTITLE=""
SET MONTITLE="Zz No title given"
+8 SET PSOMON1(DRG,MONTITLE,FDBSEV)=""
End DoDot:2
End DoDot:1
+9 if $GET(PSODLQT)
QUIT
+10 ;sort "PMON" nodes by drug and FDB severity then print monograph; MDRGCNT = monograph drug count - sequential number counting monographs per drug. If multiple monographs fro same drug allows display of each.
+11 ;; PMON = counter of # of lines in the monograph to be displayed; FDBSEV = FDB severity for each monograph within the Vista severity
+12 FOR
SET CT=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT))
if 'CT!$GET(PSODLQT)
QUIT
Begin DoDot:1
+13 SET DRGINFO=^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT)
SET PDRGIEN=$PIECE(DRGINFO,"^",2)
SET DRGIEN=$PIECE(DRGINFO,"^",3)
+14 SET PVAGDRG=$$GET1^DIQ(50,PDRGIEN,20,"E")
SET VAGDRG=$$GET1^DIQ(50,DRGIEN,20,"E")
SET MDRGCNT=MDRGCNT+1
+15 IF PVAGDRG=""
SET PVAGDRG=$PIECE(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT),"^",4)
+16 IF VAGDRG=""
SET VAGDRG=DRG
+17 SET SMONTI=$GET(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",3,0))
SET SMONTI=$PIECE(SMONTI,"MONOGRAPH TITLE: ",2)
+18 IF $DATA(PSOMON1(DRG,SMONTI))
SET FDBSEV=""
SET FDBSEV=$ORDER(PSOMON1(DRG,SMONTI,FDBSEV))
+19 SET PMON=PMON+1
SET ^TMP($JOB,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0)=PSONULN
+20 SET PMON=PMON+1
SET ^TMP($JOB,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0)="Professional Monograph"
SET PMON=PMON+1
+21 SET ^TMP($JOB,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0)="Drug Interaction with "_PVAGDRG_" and "_VAGDRG
SET PMON=PMON+1
SET ^TMP($JOB,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0)=""
+22 FOR QX=0:0
SET QX=$ORDER(^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",QX))
if 'QX
QUIT
DO FPMON
End DoDot:1
SET PMON=PMON+1
SET ^TMP($JOB,LIST,"PMON",PMON,0)=""
+23 if '$ORDER(^TMP($JOB,LIST,"PMON",0))!$GET(PSODLQT)
QUIT
+24 KILL DIR,DTOUT,DUOUT,MONQ
USE IO
WRITE @IOF
+25 IF $PIECE(ON,";")="R"
SET RMRX=$PIECE(^TMP($JOB,LIST,"OUT","REMOTE",$PIECE(ON,";",2)),"^",5)
+26 ;display monograph detailed information
+27 FOR FDBSEV=0:0
SET FDBSEV=$ORDER(^TMP($JOB,LIST,"PMON",FDBSEV))
if FDBSEV=""!($GET(MONQ))
QUIT
FOR QXX=0:0
SET QXX=$ORDER(^TMP($JOB,LIST,"PMON",FDBSEV,QXX))
if QXX=""!($GET(MONQ))
QUIT
SET PSOMONQ=0
Begin DoDot:1
+28 FOR QX=0:0
SET QX=$ORDER(^TMP($JOB,LIST,"PMON",FDBSEV,QXX,QX))
if 'QX!($GET(PSOMONQ)=1)!($GET(MONQ))
QUIT
WRITE !,^TMP($JOB,LIST,"PMON",FDBSEV,QXX,QX,0)
IF $Y+3>IOSL
Begin DoDot:2
+29 IF $EXTRACT(IOST)="C"
IF ($Y+3)>IOSL
SET PSOMONQ=$$PAUSE1()
+30 IF PSOMONQ=1
WRITE @IOF
QUIT
+31 IF PSOMONQ=2
SET MONQ=1
+32 WRITE @IOF,!
End DoDot:2
End DoDot:1
+33 QUIT
+34 ;
PAUSE1() ;Allow "^"
+1 ;Return 0 if X="" ;Return 1 if X="^" ;Return 2 if Not null or "^"
+2 NEW DIR,DIRUT,DUOUT,X
+3 WRITE !
KILL DIR
SET DIR("A")="Press RETURN to continue, ""^"" to display the next Monograph or ""^^"" to Exit"
+4 SET DIR("?")="Enter ""^"" to go to next Monograph, ""^^"" to exit the Monograph display."
+5 SET DIR(0)="FOU^^K:(X'="""")!(X'[""^"") X"
+6 DO ^DIR
+7 IF X=""
QUIT 0
+8 IF X="^"
QUIT 1
+9 QUIT 2
RDI ;RDI orders
+1 if '$DATA(^TMP($JOB,LIST,"OUT","REMOTE",$PIECE(ON,";",2)))
QUIT
+2 SET RXREC=^TMP($JOB,LIST,"OUT","REMOTE",$PIECE(ON,";",2))
+3 if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY("LOCATION: ",20)_$PIECE(RXREC,"^")_" Remote Rx: "_$PIECE(RXREC,"^",5)
+4 if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY("Drug: ",20)_$PIECE(RXREC,"^",3)_" ("_$PIECE(RXREC,"^",4)_")"
+5 DO FSIG(.FSIG)
+6 if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY("SIG: ",20)
FOR I=1:1
if '$DATA(FSIG(I))
QUIT
if '$GET(PSODUPF)
WRITE ?20,FSIG(I)
IF $ORDER(FSIG(I))
if '$GET(PSODUPF)
WRITE !
+7 IF $GET(QTHER)
if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY("QTY: ",20)_$PIECE(RXREC,"^",8),?40,$JUSTIFY("Days Supply: ",24)_$PIECE(RXREC,"^",7)
+8 if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY("Last Filled On: ",20)_$PIECE(RXREC,"^",6)
+9 SET ^TMP($JOB,"PSONRVADD",RXREC,0)=1
+10 KILL RXREC,I,FSIG
+11 QUIT
FSIG(FSIG) ;Format sig from remote site ;returned in the FSIG array
+1 KILL FSIG
NEW FFF,NNN,CNT,FVAR,FVAR1,FLIM,HSIG,II,I
+2 FOR I=0:1
if '$DATA(^TMP($JOB,LIST,"OUT","REMOTE",$PIECE(ON,";",2),"SIG",I))
QUIT
SET HSIG(I+1)=^(I)
FSTART SET (FVAR,FVAR1)=""
SET II=1
+1 FOR FFF=0:0
SET FFF=$ORDER(HSIG(FFF))
if 'FFF
QUIT
SET CNT=0
FOR NNN=1:1:$LENGTH(HSIG(FFF))
IF $EXTRACT(HSIG(FFF),NNN)=" "!($LENGTH(HSIG(FFF))=NNN)
SET CNT=CNT+1
Begin DoDot:1
+2 SET FVAR1=$PIECE(HSIG(FFF)," ",(CNT))
+3 SET FLIM=FVAR
+4 SET FVAR=$SELECT(FVAR="":FVAR1,1:FVAR_" "_FVAR1)
End DoDot:1
IF $LENGTH(FVAR)>50
SET FSIG(II)=FLIM_" "
SET II=II+1
SET FVAR=FVAR1
+5 IF $GET(FVAR)'=""
SET FSIG(II)=FVAR
+6 IF $GET(FSIG(1))=""!($GET(FSIG(1))=" ")
SET FSIG(1)=$GET(FSIG(2))
KILL FSIG(2)
FQUIT ;
+1 QUIT
DCOR ;dc duplicate therapy
+1 if '$DATA(^XUSEC("PSORPH",DUZ))!$GET(PSODLQT)
QUIT
+2 SET MSG="Discontinued During "_$SELECT('$GET(PSONV):"New Prescription Entry",1:"Verification")_" - Duplicate Therapy"
+3 SET ACT="Duplicate Therapy Discontinued while "_$SELECT('$GET(PSONV):"entering",1:"verifying")_" new RX"
+4 NEW DCN,DCRD,LST
SET THERO=0
FOR I=0:0
SET I=$ORDER(^TMP($JOB,"PSODCOR",I))
if 'I
QUIT
SET THERO=THERO+1
+5 IF THERO=1
Begin DoDot:1
+6 KILL DIR
SET DIR(0)="Y"
SET THER(1)=^TMP($JOB,"PSODCOR",1)
+7 SET DIR("A")="Discontinue "_$SELECT($PIECE(THER(1),"^")="P":"Pending Order "_$PIECE(THER(1),"^",4),1:"Rx #"_$PIECE(^PSRX($PIECE(THER(1),"^",2),0),"^")_" "_$PIECE(THER(1),"^",4))_" Y/N "
+8 DO ^DIR
if ($DATA(DTOUT))!($DATA(DUOUT))!($GET(DIRUT))
SET PSODLQT=1
SET PSORX("DFLG")=1
if $GET(PSODLQT)
QUIT
KILL DIR,DIRUT
IF 'Y
KILL DIR,THER,THERO,X,Y
QUIT
+9 SET ^TMP("PSORXDC",$JOB,$PIECE(THER(1),"^",2),0)=$PIECE(THER(1),"^")_"^"_$PIECE(THER(1),"^",2)_"^"_MSG
+10 IF $PIECE(THER(1),"^")=52
SET ^TMP("PSORXDC",$JOB,$PIECE(THER(1),"^",2),0)=^TMP("PSORXDC",$JOB,$PIECE(THER(1),"^",2),0)_"^C^"_ACT_"^"_$PIECE(THER(1),"^",3)_"^"_$PIECE(THER(1),"^",4)
SET PSONOOR="D"
+11 SET $PIECE(^TMP("PSORXDC",$JOB,$PIECE(THER(1),"^",2),0),"^",10)=1
+12 WRITE !!
KILL ^UTILITY($JOB,"W")
SET DIWL=1
SET DIWR=75
SET DIWF=""
+13 SET X="Duplicate Therapy "_$SELECT($PIECE(THER(1),"^")="P":"Pending Order ",1:"Rx #"_$PIECE(^PSRX($PIECE(THER(1),"^",2),0),"^"))_" "_$PIECE(THER(1),"^",4)_" will be discontinued after the acceptance of the new order."
DO ^DIWP
+14 FOR ZX=0:0
SET ZX=$ORDER(^UTILITY($JOB,"W",1,ZX))
if 'ZX
QUIT
WRITE !,^UTILITY($JOB,"W",1,ZX,0)
+15 KILL ^UTILITY($JOB,"W"),X,DIWL,DIWR,DIWF
WRITE !
HANG 2
End DoDot:1
QUIT
+16 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Discontinue Orders Y/N "
SET DIR("B")="No"
DO ^DIR
+17 if ($DATA(DTOUT))!($DATA(DUOUT))!($GET(DIRUT))
SET PSODLQT=1
SET PSORX("DFLG")=1
if $GET(PSODLQT)
QUIT
+18 IF 'Y
KILL DIR,X,Y
QUIT
+19 KILL DIR
SET DIR(0)="LO^1:"_THERO
+20 FOR I=1:1:THERO
SET DIR("A",I)=I_". "_$SELECT($PIECE(^TMP($JOB,"PSODCOR",I),"^")="P":"Pending Order "_$PIECE(^TMP($JOB,"PSODCOR",I),"^",4),1:"Rx #"_$PIECE(^PSRX($PIECE(^TMP($JOB,"PSODCOR",I),"^",2),0),"^")_" "_$PIECE(^TMP($JOB,"PSODCOR",I),"^",4))
+21 SET DIR("A")="Select Order(s)"
DO ^DIR
if ($DATA(DTOUT))!($DATA(DUOUT))!($GET(DIRUT))
SET PSODLQT=1
SET PSORX("DFLG")=1
if $GET(PSODLQT)
QUIT
KILL DIR,DIRUT
IF 'Y
KILL THER,THERO
QUIT
+22 SET LST=Y(0)
FOR DCRD=1:1:$LENGTH(LST,",")
if $PIECE(LST,",",DCRD)']""!$GET(PSODLQT)
QUIT
Begin DoDot:1
+23 SET DCN=$PIECE(LST,",",DCRD)
SET THER(DCN)=^TMP($JOB,"PSODCOR",DCN)
+24 SET ^TMP("PSORXDC",$JOB,$PIECE(THER(DCN),"^",2),0)=$PIECE(THER(DCN),"^")_"^"_$PIECE(THER(DCN),"^",2)_"^"_MSG
+25 IF $PIECE(THER(DCN),"^")=52
SET ^TMP("PSORXDC",$JOB,$PIECE(THER(DCN),"^",2),0)=^TMP("PSORXDC",$JOB,$PIECE(THER(DCN),"^",2),0)_"^C^"_ACT_"^"_$PIECE(THER(DCN),"^",3)_"^"_$PIECE(THER(DCN),"^",4)
SET PSONOOR="D"
+26 SET $PIECE(^TMP("PSORXDC",$JOB,$PIECE(THER(DCN),"^",2),0),"^",10)=1
+27 WRITE !
KILL ^UTILITY($JOB,"W")
SET DIWL=1
SET DIWR=75
SET DIWF=""
+28 SET X="Duplicate Therapy "_$SELECT($PIECE(THER(DCN),"^")="P":"Pending Order "_$PIECE(THER(DCN),"^",4),1:"Rx #"_$PIECE(^PSRX($PIECE(THER(DCN),"^",2),0),"^")_" "_$PIECE(THER(DCN),"^",4))_" will be discontinued after the acceptance of the
new order."
DO ^DIWP
+29 FOR ZX=0:0
SET ZX=$ORDER(^UTILITY($JOB,"W",1,ZX))
if 'ZX
QUIT
WRITE !,^UTILITY($JOB,"W",1,ZX,0)
+30 KILL ^UTILITY($JOB,"W"),X,DIWL,DIWR,DIWF
HANG 2
End DoDot:1
+31 WRITE !
KILL X,Y,THER,THERO,MSG,ACT,I,DIR
+32 QUIT
FPMON ;displays instruction and/or comments
+1 SET PMON=PMON+1
SET MG=^TMP($JOB,LIST,"OUT","DRUGDRUG",SV,DRG,ON,CT,"PMON",QX,0)
+2 IF MG=""
SET ^TMP($JOB,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0)=""
SET PMON=PMON+1
QUIT
+3 IF $LENGTH(MG)>70
FOR SG=1:1:$LENGTH(MG," ")
if $LENGTH(($GET(^TMP($JOB,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0)))_" "_$PIECE(MG," ",SG))>80
SET PMON=PMON+1
SET ^TMP($JOB,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0)=$GET(^TMP($JOB,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0))_$PIECE(MG," ",SG)_" "
+4 IF '$TEST
SET PMON=PMON+1
SET ^TMP($JOB,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0)=$GET(^TMP($JOB,LIST,"PMON",FDBSEV,MDRGCNT,PMON,0))_MG
+5 KILL MG,SG
+6 QUIT
VAGEN(PSODD) ;Return the VA GENERIC name
+1 ;PSODD - IEN (file #50)
+2 NEW PSOIEN
IF '+$GET(PSODD)
QUIT ""
+3 SET PSOIEN=+$GET(^PSDRUG(PSODD,"ND"))
DO ZERO^PSN50P6(PSOIEN,,,,"PSOVAG")
+4 SET PSOVAG=$GET(^TMP($JOB,"PSOVAG",PSOIEN,.01))
KILL ^TMP($JOB,"PSOVAG")
+5 QUIT PSOVAG
INST ;displays instruction and/or comments
+1 SET INST=0
FOR
SET INST=$ORDER(^PS(52.41,RXREC,TY,INST))
if 'INST
QUIT
SET MIG=^PS(52.41,RXREC,TY,INST,0)
Begin DoDot:1
+2 WRITE !,$SELECT(TY=2:" "_$SELECT($$ERXIEN^PSOERXUT(RXREC_"P"):"eRx",1:" ")_" Instructions: ",TY=3:" Provider Comments: ",1:"")
+3 FOR SG=1:1:$LENGTH(MIG," ")
DO HD^PSODDPR2()
if $GET(PSODLQT)
QUIT
if $X+$LENGTH($PIECE(MIG," ",SG)_" ")>IOM
WRITE @$SELECT(TY=3:"!?14",1:"!?19")
WRITE $PIECE(MIG," ",SG)_" "
End DoDot:1
+4 KILL INST,TY,MIG,SG
+5 QUIT
CLASSES ;display therapeutic duplications classes (called from PSODDPR5 too)
+1 IF '$GET(PSODUPF)
Begin DoDot:1
+2 IF '$GET(PSODUPCT)&('$GET(PSODUPC("CLASS")))
DO HD^PSODDPR2()
QUIT
+3 IF ($GET(PSODUPCT)+PSODUPC("CLASS"))>22
DO HD^PSODDPR2(15)
SET PSODUPCT=0
End DoDot:1
+4 if $GET(PSODLQT)
QUIT
+5 KILL ^UTILITY($JOB,"W")
SET DIWL=1
SET DIWR=75
SET DIWF=""
SET ZCT=0
if $GET(PSODUPF)
SET PSODUPC("CLASS")=PSODUPC("CLASS")+1
if '$GET(PSODUPF)
WRITE !
+6 SET X="Class(es) Involved in Therapeutic Duplication(s): "
DO ^DIWP
+7 SET (ZCT,ZZCT,ZZZCT)=0
FOR
SET ZZCT=$ORDER(^TMP($JOB,LIST,"OUT","THERAPY",ZZCT))
if 'ZZCT
QUIT
SET ZCT=0
FOR
SET ZCT=$ORDER(^TMP($JOB,LIST,"OUT","THERAPY",ZZCT,ZCT))
if 'ZCT
QUIT
Begin DoDot:1
+8 SET X=^TMP($JOB,LIST,"OUT","THERAPY",ZZCT,ZCT,"CLASS")
+9 SET X=^TMP($JOB,LIST,"OUT","THERAPY",ZZCT,ZCT,"CLASS")_$SELECT($ORDER(^TMP($JOB,LIST,"OUT","THERAPY",ZZCT))!($ORDER(^TMP($JOB,LIST,"OUT","THERAPY",ZZCT,ZCT))):", ",1:" ")
+10 DO ^DIWP
End DoDot:1
+11 FOR ZX=0:0
SET ZX=$ORDER(^UTILITY($JOB,"W",1,ZX))
if 'ZX
QUIT
if $GET(PSODUPF)
SET PSODUPC("CLASS")=PSODUPC("CLASS")+1
if '$GET(PSODUPF)
WRITE !,^UTILITY($JOB,"W",1,ZX,0)
+12 KILL ^UTILITY($JOB,"W"),X,CLASS,DIWL,DIWR,DIWF,ZX,DRG,ZCT,ZZCT,ZZZCT
+13 if $GET(PSODUPF)
SET PSODUPC("CLASS")=PSODUPC("CLASS")+1
if '$GET(PSODUPF)
WRITE !,PSONULN1,!
+14 QUIT
