PSODDPR7 ; BIR/OG ; Enhanced order checks - IMO Utilities ;Nov 17, 2021@14:00
;;7.0;OUTPATIENT PHARMACY;**390,411,663**;DEC 1997;Build 2
;External reference to IN^PSJBLDOC supported by DBIA 5306
;External reference to ^PS(50.606 supported by DBIA 2174
;External reference to ^PS(50.7 supported by DBIA 2223
;
; Required to be present:
; DFN: patient internal entry number
; DRG - dispensed drug name
; SV - Severity
; ZVA - VA Generic Name
; ON: Order identifier = first ";" piece: I1 - IV order. I2 - UD order; second ";" piece: order id; example: ON="C2;4;PROFILE;5"
;
Q:$E($P(ON,";"))'["C"
N DRGNAME,STATUS,STARTDT,STOPDT,SCHEDULE,ORDID,DOSAGE,FILENODE,ADD,SOL,ADDNAM,SOLNAM,BOTTLE,STRENGTH,AFLG,ADDS,SOLUTION,VOLUME,IVDATA,SORT,INFUSE,SFLG,PSOCON,PSOCLINI,SORT2,PSOCLIN
N PSOCDRG,DRGDRG,STARTDTF,STOPDTF,ORDDATE,DNM,DUPRX0,PDRG,RXREC,RDIRX
S SORT="PSOPEPS CLINIC"
S (PSOCDRG,PSOCON,STATUS)=""
Q:'$D(PSOCLNS(SV,ZVA))
;sort by status within drug name
F S PSOCDRG=$O(PSOCLNS(SV,ZVA,PSOCDRG)) Q:PSOCDRG="" I DRG=PSOCDRG F S PSOCON=$O(PSOCLNS(SV,ZVA,PSOCDRG,PSOCON)) Q:PSOCON="" D
.S (ORDID,PSOCLINI,FILENODE)="",DRGDRG=1,ORDID=$P(PSOCON,";",2),PSOCLINI=$P(^TMP($J,"PSOPEPS","IN","PROFILE",PSOCON),"^",7),FILENODE=$P(PSOCLINI,";")
.I FILENODE=1 D PSS436^PSS55(PSODFN,ORDID,SORT) S:$D(^TMP($J,SORT,ORDID,100)) STATUS=$P(^TMP($J,SORT,ORDID,100),"^",2)
.I FILENODE=2 D PSS431^PSS55(PSODFN,ORDID,"","",SORT) S:$D(^TMP($J,SORT,ORDID,28)) STATUS=$P(^TMP($J,SORT,ORDID,28),"^",2)
.I FILENODE=3!(FILENODE=4)!(FILENODE=5) D PSJ^PSJ53P1(ORDID,SORT) S:$D(^TMP($J,SORT,ORDID,28)) STATUS=$P(^TMP($J,SORT,ORDID,28),"^",2)
.I STATUS="" S STATUS="Z"
.S PSOCLIN(SV,ZVA,$S(STATUS["ACTIVE":1,STATUS["NON-VERIFIED":2,STATUS["DISCONTINUED":3,STATUS["EXPIRE":4,1:5),PSOCON)=PSOCDRG
Q:'$D(PSOCLIN(SV,ZVA))
S (SORT2,ORDID,PSOCLINI,FILENODE,PSOCON)=""
K ^TMP($J,SORT)
F S SORT2=$O(PSOCLIN(SV,ZVA,SORT2)) Q:SORT2="" F S PSOCON=$O(PSOCLIN(SV,ZVA,SORT2,PSOCON)) Q:PSOCON="" D CLINIC
Q
DUP ;
;Required: ZCT = Order identifier = first ";" piece: I1 - IV order. I2 - UD order; second ";" piece: order id; example: ON="C2;4;PROFILE;5"
Q:ZCT=""
N DRGNAME,STATUS,STARTDT,STOPDT,SCHEDULE,ORDID,DOSAGE,FILENODE,ADD,SOL,ADDNAM,SOLNAM,BOTTLE,STRENGTH,AFLG,ADDS,SOLUTION,VOLUME,IVDATA,SORT,INFUSE,SFLG,PSOCON
N PSOCLINI,SORT2,PSOCLIN,DRGDRG,STARTDTF,STOPDTF,ORDDATE,DURATION
S SORT="PSOPEPS CLINIC",DRGDRG=0
S PSOCON=$P(ZCT,"^",3),DRGNAME=$P(ZCT,"^",2) D CLINIC
Q
;
CLINIC ;
K ^TMP($J,SORT)
S (ORDID,PSOCLINI,FILENODE)="",ORDID=$P(PSOCON,";",2),PSOCLINI=$P(^TMP($J,"PSOPEPS","IN","PROFILE",PSOCON),"^",7)
Q:'PSOCLINI
S FILENODE=$P(PSOCLINI,";") I DRGDRG S DRGNAME=PSOCLIN(SV,ZVA,SORT2,PSOCON) I DRGNAME'="" S DRGDRG=0
S (STATUS,SCHEDULE,DOSAGE,STARTDT,STOPDT,INFUSE,STARTDTF,STOPDTF,ORDDATE)=""
D GETDATA
K ^TMP($J,SORT)
W !
Q
GETDATA ;
I FILENODE=1 D PSS436^PSS55(PSODFN,ORDID,SORT) D Q ;IV for file 55
.I DRGDRG S DRGNAME=$P(^TMP($J,"PSOPEPS","IN","PROFILE",PSOCON),"^",4)
.I $D(^TMP($J,SORT,ORDID,100)) S STATUS=$P(^TMP($J,SORT,ORDID,100),"^",2)
.I $D(^TMP($J,SORT,ORDID,.09)) S SCHEDULE=^TMP($J,SORT,ORDID,.09)
.I $D(^TMP($J,SORT,ORDID,109)) S DOSAGE=^TMP($J,SORT,6,109)
.I $D(^TMP($J,SORT,ORDID,.02)) S STARTDT=$P(^TMP($J,SORT,ORDID,.02),"^",2)
.I STARTDT="" S:$D(^TMP($J,SORT,ORDID,115)) STARTDT=$D(^TMP($J,SORT,ORDID,115)) S:STARTDT'="" STARTDTF=1
.I $D(^TMP($J,SORT,ORDID,.03)) S STOPDT=$P(^TMP($J,SORT,ORDID,.03),"^",2)
.S:$D(^TMP($J,SORT,ORDID,27)) ORDDATE=^TMP($J,SORT,ORDID,27)
.I STOPDT="" S:$D(^TMP($J,SORT,ORDID,117)) STARTDT=$D(^TMP($J,SORT,ORDID,117)) S:STOPDT'="" STOPDTF=1
.I $D(^TMP($J,SORT,ORDID,.08)) S INFUSE=^TMP($J,SORT,ORDID,.08)
.D WRITE
;
I FILENODE=2 D PSS431^PSS55(PSODFN,ORDID,"","",SORT) D Q ;Unit dose for file 55
.I DRGDRG S DRGNAME=$P(^TMP($J,"PSOPEPS","IN","PROFILE",PSOCON),"^",4)
.I $D(^TMP($J,SORT,ORDID,28)) S STATUS=$P(^TMP($J,SORT,ORDID,28),"^",2)
.I $D(^TMP($J,SORT,ORDID,26)) S SCHEDULE=^TMP($J,SORT,ORDID,26)
.I $D(^TMP($J,SORT,ORDID,109)) S DOSAGE=^TMP($J,SORT,ORDID,109)
.I $D(^TMP($J,SORT,ORDID,10)) S STARTDT=$P(^TMP($J,SORT,ORDID,10),"^",2)
.I $D(^TMP($J,SORT,ORDID,34)) S STOPDT=$P(^TMP($J,SORT,ORDID,34),"^",2)
.I $D(^TMP($J,SORT,ORDID,.08)) S INFUSE=^TMP($J,SORT,ORDID,.08)
.D WRITE
;
I FILENODE=3!(FILENODE=4)!(FILENODE=5) D Q ;unit dose for file 53.1
.D PSJ^PSJ53P1(ORDID,SORT)
.I DRGDRG,$D(^TMP($J,SORT,ORDID,108)) S DRGNAME=$P(^TMP($J,SORT,ORDID,108),"^",2)
.I $D(^TMP($J,SORT,ORDID,28)) S STATUS=$P(^TMP($J,SORT,ORDID,28),"^",2)
.I $D(^TMP($J,SORT,ORDID,26)) S SCHEDULE=$P(^TMP($J,SORT,ORDID,26),"^",2)
.I $D(^TMP($J,SORT,ORDID,27)) S ORDDATE=^TMP($J,SORT,ORDID,27) S Y=ORDDATE D DD^%DT S ORDDATE=Y K Y
.I $D(^TMP($J,SORT,ORDID,109)) S DOSAGE=^TMP($J,SORT,ORDID,109)
.I $D(^TMP($J,SORT,ORDID,10)) S STARTDT=$P(^TMP($J,SORT,ORDID,10),"^",2)
.I STARTDT="",$D(^TMP($J,SORT,ORDID,115)) S STARTDT=$P(^TMP($J,SORT,ORDID,115),"^",2) S:STARTDT'="" STARTDTF=1
.I $D(^TMP($J,SORT,ORDID,25)) S STOPDT=$P(^TMP($J,SORT,ORDID,25),"^",2)
.I $D(^TMP($J,SORT,ORDID,117))&(STOPDT="") S STOPDT=$P(^TMP($J,SORT,ORDID,117),"^",2) S:STOPDT'="" STOPDTF=1
.I $D(^TMP($J,SORT,ORDID,116)) S DURATION=^TMP($J,SORT,ORDID,116)
.D WRITE
Q
;
WRITE ;
D HD^PSODDPR2() Q:$G(PSODLQT)
S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1
;PSO*7.0*663 begin - check for pending clinic orders
; with free text dosages (i.e. no dispense drug).
N PSODRUGX
S PSODRUGX=DRGNAME
I $G(ORDID),$P($G(^PS(53.1,+ORDID,0)),U,9)="P" D
. I $O(^PS(53.1,+ORDID,1,0)) Q
. ;no dispense drug, so display only name and dosage type (TAB, etc.)
. N PSOIENX
. S PSOIENX=$$GET1^DIQ(53.1,+ORDID,108,"I")
. S PSODRUGX=$$GET1^DIQ(50.7,PSOIENX,.01)_" "_$$GET1^DIQ(50.7,PSOIENX,.02)
W:'$G(PSODUPF) !,$J("Clinic Order: ",23)_PSODRUGX_" ("_STATUS_")"
;PSO*7.0*663 end
I $D(^TMP($J,SORT,ORDID,"ADD")) D:FILENODE=1 IV55 D:FILENODE=3 IV531
I SCHEDULE'="" S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Schedule: ",23),SCHEDULE
I DOSAGE'="" S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Dosage: ",23),DOSAGE
I STARTDT=""&(ORDDATE'="") S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Order Date: ",23),ORDDATE
I STARTDT'="" S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J($S($G(STARTDTF):"Requested Start Date: ",1:"Start Date: "),23),STARTDT
E S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Start Date: ",23),"********"
I STOPDT'="" S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J($S($G(STOPDTF):"Requested Stop Date: ",1:"Stop Date: "),23),STOPDT
E S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1 W:'$G(PSODUPF) !,$J("Stop Date: ",23),"********"
WRITE2 ;
I '$G(PSODUPF) D HD^PSODDPR2():(($Y+5)>IOSL)
Q
;
IMO(DFN) ;Inpatient Meds ordered in outpatient pharmacy (IMO) - determine IMO drugs to be added to the profile drugs submitted to FDB.
; In: DFN - Patient IED
; Output: ^TMP( file of inpatient meds drugs; example of each type of order:
; ^TMP(540771229,"PSOPEPS","IN","PROFILE","C2;6;PROFILE;6")="16579^4010153^65^SIMVASTATIN 40MG TAB^10711^I"
; ^TMP(540771229,"PSOPEPS","IN","PROFILE","C4;1597;PROFILE;7")="11664^4006819^1848^CIMETIDINE 300MG/5ML SOL (OZ)^10746^I"
;
; The first piece of the 5th subscript denotes the type of order (ex: C2 and C4 in the example above).
; When adding clinic orders, this piece is always "C" concatenated with an number 1-4 where 1 means UD file 55, 2 means IV file 55, 3 means UD file 53.1 or 4 means IV for file 53.1.
; For clinic orders, the 2nd piece of the 5th subscript is the subfile IEN.
;
D IN^PSJBLDOC(DFN,LIST,.PDRG,"O;")
Q
;
IV55 ;
I '$G(PSODUPF) D HD^PSODDPR2() Q:$G(PSODLQT)
S (ADD,SOL,AFLG)=0
;W:'$G(AFLG) !,$J("Other Additives: ",23)
F S ADD=$O(^TMP($J,SORT,ORDID,"ADD",ADD)) Q:ADD="" D
.I $D(^TMP($J,SORT,ORDID,"ADD",ADD,.01)) S ADDNAM=$P(^TMP($J,SORT,ORDID,"ADD",ADD,.01),"^",2)
.Q:DRGNAME[(ADDNAM_" "_^TMP($J,SORT,ORDID,"ADD",ADD,.02))
.S (BOTTLE,STRENGTH)=""
.I $D(^TMP($J,SORT,ORDID,"ADD",ADD,.03)) S BOTTLE=^TMP($J,SORT,ORDID,"ADD",ADD,.03)
.I $D(^TMP($J,SORT,ORDID,"ADD",ADD,.02)) S STRENGTH=^TMP($J,SORT,ORDID,"ADD",ADD,.02)
.I '$G(AFLG) S ADDS=ADDNAM_" "_STRENGTH S:BOTTLE'="" ADDS=ADDS_" ("_BOTTLE_")"
.I $G(AFLG) S ADDS=ADDS_", "_ADDNAM_" "_STRENGTH S:BOTTLE'="" ADDS=ADDS_" ("_BOTTLE_")"
.S:'$G(AFLG) AFLG=1
S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1
I '$G(PSODUPF) D HD^PSODDPR2() Q:$G(PSODLQT)
I $G(AFLG),'$G(PSODUPF) W !,$J("Other Additives: ",23) D MYWRITE(ADDS,23,78)
F S SOL=$O(^TMP($J,SORT,ORDID,"SOL",SOL)) Q:SOL="" D
.S (SOLUTION,VOLUME)=""
.I $D(^TMP($J,SORT,ORDID,"SOL",SOL,.01)) S SOLUTION=$P(^TMP($J,SORT,ORDID,"SOL",SOL,.01),"^",2)
.I $D(^TMP($J,SORT,ORDID,"SOL",SOL,1)) S VOLUME=^TMP($J,SORT,ORDID,"SOL",SOL,1)
.I '$G(PSODUPF) D HD^PSODDPR2() Q:$G(PSODLQT)
.W:'$G(SFLG)&'$G(PSODUPF) !,$J("Solution(s): ",23)_SOLUTION_" "_VOLUME_" "_INFUSE
.S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1
.I $G(SFLG),'$G(PSODUPF) W !?23,SOLUTION_" "_VOLUME_" "_INFUSE
.S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1
.S SFLG=1
Q
;
IV531 ;
I '$G(PSODUPF) D HD^PSODDPR2() Q:$G(PSODLQT)
S (ADD,SOL,AFLG,SFLG)=0
F S ADD=$O(^TMP($J,SORT,ORDID,"ADD",ADD)) Q:ADD="" D
.S (BOTTLE,STRENGTH,IVDATA)="",IVDATA=^TMP($J,SORT,ORDID,"ADD",ADD)
.S BOTTLE=$P(IVDATA,"^",3),STRENGTH=$P(IVDATA,"^",2),ADDNAM=$P(IVDATA,"^")
.I $D(^TMP($J,SORT,ORDID,"ADD",ADD+1)) Q:DRGNAME[(ADDNAM_" "_STRENGTH)
.I '$G(AFLG) S ADDS=ADDNAM_" "_STRENGTH S:BOTTLE'="" ADDS=ADDS_" ("_BOTTLE_")"
.I $G(AFLG) S ADDS=ADDS_", "_ADDNAM_" "_STRENGTH S:BOTTLE'="" ADDS=ADDS_" ("_BOTTLE_")"
.S:'$G(AFLG) AFLG=1
S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1
I '$G(PSODUPF) D HD^PSODDPR2() Q:$G(PSODLQT)
I $G(AFLG),'$G(PSODUPF) W !,$J("Other Additives: ",23) D MYWRITE(ADDS,23,78)
F S SOL=$O(^TMP($J,SORT,ORDID,"SOL",SOL)) Q:SOL="" D
.S (SOLUTION,VOLUME)=""
.S (SOLUTION,VOLUME,IVDATA)="",IVDATA=^TMP($J,SORT,ORDID,"SOL",SOL)
.S VOLUME=$P(IVDATA,"^",2),SOLUTION=$P(IVDATA,"^")
.S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1
.W:'$G(SFLG)&'$G(PSODUPF) !,$J("Solution(s): ",23)_SOLUTION_" "_VOLUME_" "_INFUSE
.I $G(SFLG),'$G(PSODUPF) W !?23,SOLUTION_" "_VOLUME_" "_INFUSE
.S:$G(PSODUPF) PSODUPC(ZCT)=PSODUPC(ZCT)+1
.S SFLG=1
I '$G(PSODUPF) D HD^PSODDPR2() Q:$G(PSODLQT)
Q
;
MYWRITE(X,DIWL,DIWR) ;Continue writing on the same line
NEW DN,PSOCNT
I '$G(DIWL) S DIWL=1
I '$G(DIWR) S DIWR=75
K ^UTILITY($J,"W") D ^DIWP
F PSOCNT=0:0 S PSOCNT=$O(^UTILITY($J,"W",DIWL,PSOCNT)) Q:'PSOCNT W:PSOCNT'=1 ! W ?DIWL,^UTILITY($J,"W",DIWL,PSOCNT,0)
Q
NOCAN ;shows duplicate therapeutic when cancel duplicate class parameter is set to 'no'
K ^UTILITY($J,"W"),DDTH,DOCPL,DIWF S DIWL=1,DIWR=78,DIWF=""
N DUPCPF,PSODUPT,ZZOCTD,CLINTYP,CT,SUB,ZZOC S ZZOCTD=0
S (CT,SUB,ZZOC)=0 K TCT,TCTP,TCTL,TCTI,ZZQ,ZHDR ;PSO*7*411
F S CT=$O(^TMP($J,LIST,"OUT","THERAPY",CT)) Q:'CT F S SUB=$O(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB)) Q:'SUB D
.S ON=$P(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB),"^"),PDRG=$P(^(SUB),"^",3),RXREC=$P(ON,";",2)
.I $G(PSODCTH(ON)) Q
.I $P(ON,";")="Z" Q
.I $P(ON,";")="N",$G(^TMP($J,"PSONVADD",RXREC,0)) Q
.I $P(ON,";")="R",$G(^TMP($J,"PSORMDD",RXREC,0)) Q
.I $P(ON,";")="O",$G(^TMP("PSORXDC",$J,RXREC,0)) Q
.I $P(ON,";")="P",$G(^TMP("PSORXDC",$J,RXREC,0)) Q
.I $P(ON,";")="O",$G(^TMP("PSORXDD",$J,RXREC,0)) Q
.I '$G(ZHDR) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) W !,PSONULN,!,"*** THERAPEUTIC DUPLICATION(S) *** "_PSODRUG("NAME")_" with",! S ZHDR=1
Q:'$G(ZHDR) Q:$G(PSODLQT)
N ST,STA,STAT,ORT,CT K DOCPL
S (SUB,CT)=0 F S CT=$O(^TMP($J,LIST,"OUT","THERAPY",CT)) Q:'CT F S SUB=$O(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB)) Q:'SUB D DUPCL K DDTH
D DUPCP
S:$D(ZPSODCTH) ^TMP("PSODAOC",$J,"DT","T","A",50,PSODRUG("IEN"),0)=""
Q
DUPCL ;
S ON=$P(^TMP($J,LIST,"OUT","THERAPY",CT,"DRUGS",SUB),"^"),PDRG=$P(^(SUB),"^",3),RXREC=$P(ON,";",2)
I $P(ON,";")="Z" Q
I $P(ON,";")="N",$G(^TMP($J,"PSONVADD",RXREC,0)) Q
I $P(ON,";")="R",$G(^TMP($J,"PSORMDD",RXREC,0)) Q
I $P(ON,";")="O",$G(^TMP("PSORXDC",$J,RXREC,0)) Q
I $P(ON,";")="P",$G(^TMP("PSORXDC",$J,RXREC,0)) Q
I $P(ON,";")="O",$G(^TMP("PSORXDD",$J,RXREC,0)) Q
S ORT=$S($P(ON,";")="N":4,$P(ON,";")="P":3,$P(ON,";")="R":2,1:1)
S DOCPL(ORT,ON)=""
Q
;
DUPCP D HD^PSODDPR2():(($Y+5)'>IOSL) S ORT=0,ON="" F S ORT=$O(DOCPL(ORT)) Q:'ORT!$G(PSODLQT) F S ON=$O(DOCPL(ORT,ON)) Q:ON=""!$G(PSODLQT) D
.S PSODUPT=""
.I $P(ON,";")="O" S PSODUPT="O" D
..D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) S ST=$P(^PSRX($P(ON,";",2),"STA"),"^")+1
..S STA="ACTIVE^NON-VERIFIED^REFILL^HOLD^NON-VERIFIED^SUSPENDED^^^^^^EXPIRED^DISCONTINUED^^DISCONTINUED BY PROVIDER^DISCONTINUE EDIT^PROVIDER HOLD"
..S STAT=$P(STA,"^",ST) W !?2,"Local Rx #"_$P(^PSRX($P(ON,";",2),0),"^")_" ("_STAT_") for "_$P(^PSDRUG($P(^PSRX($P(ON,";",2),0),"^",6),0),"^")
.I $P(ON,";")="P" S PSODUPT="P" D
..D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT)
..S RXREC=$P(ON,";",2),DNM=$P(^PS(52.41,RXREC,0),"^",9)
..S DUPRX0=^PS(52.41,RXREC,0)
..W !?2,"Pending Order for "
..I '$P(DUPRX0,"^",9) W $P(^PS(50.7,$P(DUPRX0,"^",8),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
..E W $P(^PSDRUG($P(DUPRX0,"^",9),0),"^")
.I $P(ON,";")="R" S PSODUPT="R" N RXDAT D
..D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT)
..S RXDAT=^TMP($J,LIST,"OUT","REMOTE",$P(ON,";",2))
..S RDIRX=$P(RXDAT,"^",5) D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT) W !?2,"Remote Rx #"_RDIRX_" ("_$P(RXDAT,"^",4)_") for "_$P(RXDAT,"^",3)
.I $P(ON,";")="N" S PSODUPT="N" D
..Q:'$D(^PS(55,PSODFN,"NVA",$P(ON,";",2),0))
..S DUPRX0=^PS(55,PSODFN,"NVA",$P(ON,";",2),0) N NVAQ
..D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT)
..W !?2,"Non-VA Med for "
..I '$P(DUPRX0,"^",2) W $P(^PS(50.7,$P(DUPRX0,"^"),0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")
..E W $P(^PSDRUG($P(DUPRX0,"^",2),0),"^")
.I $P(ON,";")["C" S PSODUPT="C" D
..;CLINIC ORDERS ;1=55V,2=55U,3=531I,4=531U,5=531I
..N DRGNAME S DRGNAME=$P($G(^TMP($J,LIST,"IN","PROFILE",ON)),"^",4)
..S (PSOCON,ORDID,ZCT,CLINTYP)=ON,DRGDRG=0,DUPCPF=1,SORT="PSOPEPS CLINIC" D CLINIC
..S CLINTYP=$P(^TMP($J,"PSOPEPS","IN","PROFILE",ON),"^",7)
..S ZZOCTD=ZZOCTD+1,ZPSODCTH(ON)=$S($P(CLINTYP,";")[1:"V",$P(CLINTYP,";")[3!($P(CLINTYP,";")[4)!(($P(CLINTYP,";")[5)):$E($P(ON,";",1),2)_";PS(53.1",1:"U")_";"_$P(ON,";",2)
..S ^TMP("PSODAOC",$J,"DT","T","A",70,ZZOCTD,0)=ZPSODCTH(ON)
..;S ^TMP("PSODAOC",$J,"DT","T","A",70,"ADDITIVE",ZPSODCTH(ON),
.S DDTH(ON)=1
.I PSODUPT="R" S ZZOCTD=ZZOCTD+1,ZPSODCTH(ON)="R;"_$P(ON,";",2) S ^TMP("PSODAOC",$J,"DT","T","A",70,ZZOCTD,0)=ZPSODCTH(ON)
.I PSODUPT="N" S ZZOCTD=ZZOCTD+1,ZPSODCTH(ON)="N;"_$P(ON,";",2) S ^TMP("PSODAOC",$J,"DT","T","A",70,ZZOCTD,0)=ZPSODCTH(ON)
.I PSODUPT="P" S ZZOCTD=ZZOCTD+1,ZPSODCTH(ON)=$P(ON,";",2)_";PS(52.41" S ^TMP("PSODAOC",$J,"DT","T","A",60,ZZOCTD,0)=ZPSODCTH(ON)
.I PSODUPT="O" S ZZOCTD=ZZOCTD+1,ZPSODCTH(ON)=$P(ON,";",2)_";PSRX(" S ^TMP("PSODAOC",$J,"DT","T","A",60,ZZOCTD,0)=ZPSODCTH(ON)
.S:$D(ZPSODCTH) ^TMP("PSODAOC",$J,"DT","T","A",50,PSODRUG("IEN"),0)=""
D HD^PSODDPR2():(($Y+5)'>IOSL) Q:$G(PSODLQT)
D CLASSES^PSODDPR3
N X,ZZCT S (ZCT,ZZCT)=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:"")
.I $G(X)]"" S ^TMP("PSODAOC",$J,"DT","T","A","CL",ZZCT,0)=X
D HD^PSODDPR2(0,1) Q:$G(PSODLQT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODDPR7 15932 printed Sep 23, 2025@20:02:44 Page 2
PSODDPR7 ; BIR/OG ; Enhanced order checks - IMO Utilities ;Nov 17, 2021@14:00
+1 ;;7.0;OUTPATIENT PHARMACY;**390,411,663**;DEC 1997;Build 2
+2 ;External reference to IN^PSJBLDOC supported by DBIA 5306
+3 ;External reference to ^PS(50.606 supported by DBIA 2174
+4 ;External reference to ^PS(50.7 supported by DBIA 2223
+5 ;
+6 ; Required to be present:
+7 ; DFN: patient internal entry number
+8 ; DRG - dispensed drug name
+9 ; SV - Severity
+10 ; ZVA - VA Generic Name
+11 ; ON: Order identifier = first ";" piece: I1 - IV order. I2 - UD order; second ";" piece: order id; example: ON="C2;4;PROFILE;5"
+12 ;
+13 if $EXTRACT($PIECE(ON,";"))'["C"
QUIT
+14 NEW DRGNAME,STATUS,STARTDT,STOPDT,SCHEDULE,ORDID,DOSAGE,FILENODE,ADD,SOL,ADDNAM,SOLNAM,BOTTLE,STRENGTH,AFLG,ADDS,SOLUTION,VOLUME,IVDATA,SORT,INFUSE,SFLG,PSOCON,PSOCLINI,SORT2,PSOCLIN
+15 NEW PSOCDRG,DRGDRG,STARTDTF,STOPDTF,ORDDATE,DNM,DUPRX0,PDRG,RXREC,RDIRX
+16 SET SORT="PSOPEPS CLINIC"
+17 SET (PSOCDRG,PSOCON,STATUS)=""
+18 if '$DATA(PSOCLNS(SV,ZVA))
QUIT
+19 ;sort by status within drug name
+20 FOR
SET PSOCDRG=$ORDER(PSOCLNS(SV,ZVA,PSOCDRG))
if PSOCDRG=""
QUIT
IF DRG=PSOCDRG
FOR
SET PSOCON=$ORDER(PSOCLNS(SV,ZVA,PSOCDRG,PSOCON))
if PSOCON=""
QUIT
Begin DoDot:1
+21 SET (ORDID,PSOCLINI,FILENODE)=""
SET DRGDRG=1
SET ORDID=$PIECE(PSOCON,";",2)
SET PSOCLINI=$PIECE(^TMP($JOB,"PSOPEPS","IN","PROFILE",PSOCON),"^",7)
SET FILENODE=$PIECE(PSOCLINI,";")
+22 IF FILENODE=1
DO PSS436^PSS55(PSODFN,ORDID,SORT)
if $DATA(^TMP($JOB,SORT,ORDID,100))
SET STATUS=$PIECE(^TMP($JOB,SORT,ORDID,100),"^",2)
+23 IF FILENODE=2
DO PSS431^PSS55(PSODFN,ORDID,"","",SORT)
if $DATA(^TMP($JOB,SORT,ORDID,28))
SET STATUS=$PIECE(^TMP($JOB,SORT,ORDID,28),"^",2)
+24 IF FILENODE=3!(FILENODE=4)!(FILENODE=5)
DO PSJ^PSJ53P1(ORDID,SORT)
if $DATA(^TMP($JOB,SORT,ORDID,28))
SET STATUS=$PIECE(^TMP($JOB,SORT,ORDID,28),"^",2)
+25 IF STATUS=""
SET STATUS="Z"
+26 SET PSOCLIN(SV,ZVA,$SELECT(STATUS["ACTIVE":1,STATUS["NON-VERIFIED":2,STATUS["DISCONTINUED":3,STATUS["EXPIRE":4,1:5),PSOCON)=PSOCDRG
End DoDot:1
+27 if '$DATA(PSOCLIN(SV,ZVA))
QUIT
+28 SET (SORT2,ORDID,PSOCLINI,FILENODE,PSOCON)=""
+29 KILL ^TMP($JOB,SORT)
+30 FOR
SET SORT2=$ORDER(PSOCLIN(SV,ZVA,SORT2))
if SORT2=""
QUIT
FOR
SET PSOCON=$ORDER(PSOCLIN(SV,ZVA,SORT2,PSOCON))
if PSOCON=""
QUIT
DO CLINIC
+31 QUIT
DUP ;
+1 ;Required: ZCT = Order identifier = first ";" piece: I1 - IV order. I2 - UD order; second ";" piece: order id; example: ON="C2;4;PROFILE;5"
+2 if ZCT=""
QUIT
+3 NEW DRGNAME,STATUS,STARTDT,STOPDT,SCHEDULE,ORDID,DOSAGE,FILENODE,ADD,SOL,ADDNAM,SOLNAM,BOTTLE,STRENGTH,AFLG,ADDS,SOLUTION,VOLUME,IVDATA,SORT,INFUSE,SFLG,PSOCON
+4 NEW PSOCLINI,SORT2,PSOCLIN,DRGDRG,STARTDTF,STOPDTF,ORDDATE,DURATION
+5 SET SORT="PSOPEPS CLINIC"
SET DRGDRG=0
+6 SET PSOCON=$PIECE(ZCT,"^",3)
SET DRGNAME=$PIECE(ZCT,"^",2)
DO CLINIC
+7 QUIT
+8 ;
CLINIC ;
+1 KILL ^TMP($JOB,SORT)
+2 SET (ORDID,PSOCLINI,FILENODE)=""
SET ORDID=$PIECE(PSOCON,";",2)
SET PSOCLINI=$PIECE(^TMP($JOB,"PSOPEPS","IN","PROFILE",PSOCON),"^",7)
+3 if 'PSOCLINI
QUIT
+4 SET FILENODE=$PIECE(PSOCLINI,";")
IF DRGDRG
SET DRGNAME=PSOCLIN(SV,ZVA,SORT2,PSOCON)
IF DRGNAME'=""
SET DRGDRG=0
+5 SET (STATUS,SCHEDULE,DOSAGE,STARTDT,STOPDT,INFUSE,STARTDTF,STOPDTF,ORDDATE)=""
+6 DO GETDATA
+7 KILL ^TMP($JOB,SORT)
+8 WRITE !
+9 QUIT
GETDATA ;
+1 ;IV for file 55
IF FILENODE=1
DO PSS436^PSS55(PSODFN,ORDID,SORT)
Begin DoDot:1
+2 IF DRGDRG
SET DRGNAME=$PIECE(^TMP($JOB,"PSOPEPS","IN","PROFILE",PSOCON),"^",4)
+3 IF $DATA(^TMP($JOB,SORT,ORDID,100))
SET STATUS=$PIECE(^TMP($JOB,SORT,ORDID,100),"^",2)
+4 IF $DATA(^TMP($JOB,SORT,ORDID,.09))
SET SCHEDULE=^TMP($JOB,SORT,ORDID,.09)
+5 IF $DATA(^TMP($JOB,SORT,ORDID,109))
SET DOSAGE=^TMP($JOB,SORT,6,109)
+6 IF $DATA(^TMP($JOB,SORT,ORDID,.02))
SET STARTDT=$PIECE(^TMP($JOB,SORT,ORDID,.02),"^",2)
+7 IF STARTDT=""
if $DATA(^TMP($JOB,SORT,ORDID,115))
SET STARTDT=$DATA(^TMP($JOB,SORT,ORDID,115))
if STARTDT'=""
SET STARTDTF=1
+8 IF $DATA(^TMP($JOB,SORT,ORDID,.03))
SET STOPDT=$PIECE(^TMP($JOB,SORT,ORDID,.03),"^",2)
+9 if $DATA(^TMP($JOB,SORT,ORDID,27))
SET ORDDATE=^TMP($JOB,SORT,ORDID,27)
+10 IF STOPDT=""
if $DATA(^TMP($JOB,SORT,ORDID,117))
SET STARTDT=$DATA(^TMP($JOB,SORT,ORDID,117))
if STOPDT'=""
SET STOPDTF=1
+11 IF $DATA(^TMP($JOB,SORT,ORDID,.08))
SET INFUSE=^TMP($JOB,SORT,ORDID,.08)
+12 DO WRITE
End DoDot:1
QUIT
+13 ;
+14 ;Unit dose for file 55
IF FILENODE=2
DO PSS431^PSS55(PSODFN,ORDID,"","",SORT)
Begin DoDot:1
+15 IF DRGDRG
SET DRGNAME=$PIECE(^TMP($JOB,"PSOPEPS","IN","PROFILE",PSOCON),"^",4)
+16 IF $DATA(^TMP($JOB,SORT,ORDID,28))
SET STATUS=$PIECE(^TMP($JOB,SORT,ORDID,28),"^",2)
+17 IF $DATA(^TMP($JOB,SORT,ORDID,26))
SET SCHEDULE=^TMP($JOB,SORT,ORDID,26)
+18 IF $DATA(^TMP($JOB,SORT,ORDID,109))
SET DOSAGE=^TMP($JOB,SORT,ORDID,109)
+19 IF $DATA(^TMP($JOB,SORT,ORDID,10))
SET STARTDT=$PIECE(^TMP($JOB,SORT,ORDID,10),"^",2)
+20 IF $DATA(^TMP($JOB,SORT,ORDID,34))
SET STOPDT=$PIECE(^TMP($JOB,SORT,ORDID,34),"^",2)
+21 IF $DATA(^TMP($JOB,SORT,ORDID,.08))
SET INFUSE=^TMP($JOB,SORT,ORDID,.08)
+22 DO WRITE
End DoDot:1
QUIT
+23 ;
+24 ;unit dose for file 53.1
IF FILENODE=3!(FILENODE=4)!(FILENODE=5)
Begin DoDot:1
+25 DO PSJ^PSJ53P1(ORDID,SORT)
+26 IF DRGDRG
IF $DATA(^TMP($JOB,SORT,ORDID,108))
SET DRGNAME=$PIECE(^TMP($JOB,SORT,ORDID,108),"^",2)
+27 IF $DATA(^TMP($JOB,SORT,ORDID,28))
SET STATUS=$PIECE(^TMP($JOB,SORT,ORDID,28),"^",2)
+28 IF $DATA(^TMP($JOB,SORT,ORDID,26))
SET SCHEDULE=$PIECE(^TMP($JOB,SORT,ORDID,26),"^",2)
+29 IF $DATA(^TMP($JOB,SORT,ORDID,27))
SET ORDDATE=^TMP($JOB,SORT,ORDID,27)
SET Y=ORDDATE
DO DD^%DT
SET ORDDATE=Y
KILL Y
+30 IF $DATA(^TMP($JOB,SORT,ORDID,109))
SET DOSAGE=^TMP($JOB,SORT,ORDID,109)
+31 IF $DATA(^TMP($JOB,SORT,ORDID,10))
SET STARTDT=$PIECE(^TMP($JOB,SORT,ORDID,10),"^",2)
+32 IF STARTDT=""
IF $DATA(^TMP($JOB,SORT,ORDID,115))
SET STARTDT=$PIECE(^TMP($JOB,SORT,ORDID,115),"^",2)
if STARTDT'=""
SET STARTDTF=1
+33 IF $DATA(^TMP($JOB,SORT,ORDID,25))
SET STOPDT=$PIECE(^TMP($JOB,SORT,ORDID,25),"^",2)
+34 IF $DATA(^TMP($JOB,SORT,ORDID,117))&(STOPDT="")
SET STOPDT=$PIECE(^TMP($JOB,SORT,ORDID,117),"^",2)
if STOPDT'=""
SET STOPDTF=1
+35 IF $DATA(^TMP($JOB,SORT,ORDID,116))
SET DURATION=^TMP($JOB,SORT,ORDID,116)
+36 DO WRITE
End DoDot:1
QUIT
+37 QUIT
+38 ;
WRITE ;
+1 DO HD^PSODDPR2()
if $GET(PSODLQT)
QUIT
+2 if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
+3 ;PSO*7.0*663 begin - check for pending clinic orders
+4 ; with free text dosages (i.e. no dispense drug).
+5 NEW PSODRUGX
+6 SET PSODRUGX=DRGNAME
+7 IF $GET(ORDID)
IF $PIECE($GET(^PS(53.1,+ORDID,0)),U,9)="P"
Begin DoDot:1
+8 IF $ORDER(^PS(53.1,+ORDID,1,0))
QUIT
+9 ;no dispense drug, so display only name and dosage type (TAB, etc.)
+10 NEW PSOIENX
+11 SET PSOIENX=$$GET1^DIQ(53.1,+ORDID,108,"I")
+12 SET PSODRUGX=$$GET1^DIQ(50.7,PSOIENX,.01)_" "_$$GET1^DIQ(50.7,PSOIENX,.02)
End DoDot:1
+13 if '$GET(PSODUPF)
WRITE !,$JUSTIFY("Clinic Order: ",23)_PSODRUGX_" ("_STATUS_")"
+14 ;PSO*7.0*663 end
+15 IF $DATA(^TMP($JOB,SORT,ORDID,"ADD"))
if FILENODE=1
DO IV55
if FILENODE=3
DO IV531
+16 IF SCHEDULE'=""
if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY("Schedule: ",23),SCHEDULE
+17 IF DOSAGE'=""
if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY("Dosage: ",23),DOSAGE
+18 IF STARTDT=""&(ORDDATE'="")
if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY("Order Date: ",23),ORDDATE
+19 IF STARTDT'=""
if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY($SELECT($GET(STARTDTF):"Requested Start Date: ",1:"Start Date: "),23),STARTDT
+20 IF '$TEST
if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY("Start Date: ",23),"********"
+21 IF STOPDT'=""
if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY($SELECT($GET(STOPDTF):"Requested Stop Date: ",1:"Stop Date: "),23),STOPDT
+22 IF '$TEST
if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
if '$GET(PSODUPF)
WRITE !,$JUSTIFY("Stop Date: ",23),"********"
WRITE2 ;
+1 IF '$GET(PSODUPF)
if (($Y+5)>IOSL)
DO HD^PSODDPR2()
+2 QUIT
+3 ;
IMO(DFN) ;Inpatient Meds ordered in outpatient pharmacy (IMO) - determine IMO drugs to be added to the profile drugs submitted to FDB.
+1 ; In: DFN - Patient IED
+2 ; Output: ^TMP( file of inpatient meds drugs; example of each type of order:
+3 ; ^TMP(540771229,"PSOPEPS","IN","PROFILE","C2;6;PROFILE;6")="16579^4010153^65^SIMVASTATIN 40MG TAB^10711^I"
+4 ; ^TMP(540771229,"PSOPEPS","IN","PROFILE","C4;1597;PROFILE;7")="11664^4006819^1848^CIMETIDINE 300MG/5ML SOL (OZ)^10746^I"
+5 ;
+6 ; The first piece of the 5th subscript denotes the type of order (ex: C2 and C4 in the example above).
+7 ; When adding clinic orders, this piece is always "C" concatenated with an number 1-4 where 1 means UD file 55, 2 means IV file 55, 3 means UD file 53.1 or 4 means IV for file 53.1.
+8 ; For clinic orders, the 2nd piece of the 5th subscript is the subfile IEN.
+9 ;
+10 DO IN^PSJBLDOC(DFN,LIST,.PDRG,"O;")
+11 QUIT
+12 ;
IV55 ;
+1 IF '$GET(PSODUPF)
DO HD^PSODDPR2()
if $GET(PSODLQT)
QUIT
+2 SET (ADD,SOL,AFLG)=0
+3 ;W:'$G(AFLG) !,$J("Other Additives: ",23)
+4 FOR
SET ADD=$ORDER(^TMP($JOB,SORT,ORDID,"ADD",ADD))
if ADD=""
QUIT
Begin DoDot:1
+5 IF $DATA(^TMP($JOB,SORT,ORDID,"ADD",ADD,.01))
SET ADDNAM=$PIECE(^TMP($JOB,SORT,ORDID,"ADD",ADD,.01),"^",2)
+6 if DRGNAME[(ADDNAM_" "_^TMP($JOB,SORT,ORDID,"ADD",ADD,.02))
QUIT
+7 SET (BOTTLE,STRENGTH)=""
+8 IF $DATA(^TMP($JOB,SORT,ORDID,"ADD",ADD,.03))
SET BOTTLE=^TMP($JOB,SORT,ORDID,"ADD",ADD,.03)
+9 IF $DATA(^TMP($JOB,SORT,ORDID,"ADD",ADD,.02))
SET STRENGTH=^TMP($JOB,SORT,ORDID,"ADD",ADD,.02)
+10 IF '$GET(AFLG)
SET ADDS=ADDNAM_" "_STRENGTH
if BOTTLE'=""
SET ADDS=ADDS_" ("_BOTTLE_")"
+11 IF $GET(AFLG)
SET ADDS=ADDS_", "_ADDNAM_" "_STRENGTH
if BOTTLE'=""
SET ADDS=ADDS_" ("_BOTTLE_")"
+12 if '$GET(AFLG)
SET AFLG=1
End DoDot:1
+13 if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
+14 IF '$GET(PSODUPF)
DO HD^PSODDPR2()
if $GET(PSODLQT)
QUIT
+15 IF $GET(AFLG)
IF '$GET(PSODUPF)
WRITE !,$JUSTIFY("Other Additives: ",23)
DO MYWRITE(ADDS,23,78)
+16 FOR
SET SOL=$ORDER(^TMP($JOB,SORT,ORDID,"SOL",SOL))
if SOL=""
QUIT
Begin DoDot:1
+17 SET (SOLUTION,VOLUME)=""
+18 IF $DATA(^TMP($JOB,SORT,ORDID,"SOL",SOL,.01))
SET SOLUTION=$PIECE(^TMP($JOB,SORT,ORDID,"SOL",SOL,.01),"^",2)
+19 IF $DATA(^TMP($JOB,SORT,ORDID,"SOL",SOL,1))
SET VOLUME=^TMP($JOB,SORT,ORDID,"SOL",SOL,1)
+20 IF '$GET(PSODUPF)
DO HD^PSODDPR2()
if $GET(PSODLQT)
QUIT
+21 if '$GET(SFLG)&'$GET(PSODUPF)
WRITE !,$JUSTIFY("Solution(s): ",23)_SOLUTION_" "_VOLUME_" "_INFUSE
+22 if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
+23 IF $GET(SFLG)
IF '$GET(PSODUPF)
WRITE !?23,SOLUTION_" "_VOLUME_" "_INFUSE
+24 if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
+25 SET SFLG=1
End DoDot:1
+26 QUIT
+27 ;
IV531 ;
+1 IF '$GET(PSODUPF)
DO HD^PSODDPR2()
if $GET(PSODLQT)
QUIT
+2 SET (ADD,SOL,AFLG,SFLG)=0
+3 FOR
SET ADD=$ORDER(^TMP($JOB,SORT,ORDID,"ADD",ADD))
if ADD=""
QUIT
Begin DoDot:1
+4 SET (BOTTLE,STRENGTH,IVDATA)=""
SET IVDATA=^TMP($JOB,SORT,ORDID,"ADD",ADD)
+5 SET BOTTLE=$PIECE(IVDATA,"^",3)
SET STRENGTH=$PIECE(IVDATA,"^",2)
SET ADDNAM=$PIECE(IVDATA,"^")
+6 IF $DATA(^TMP($JOB,SORT,ORDID,"ADD",ADD+1))
if DRGNAME[(ADDNAM_" "_STRENGTH)
QUIT
+7 IF '$GET(AFLG)
SET ADDS=ADDNAM_" "_STRENGTH
if BOTTLE'=""
SET ADDS=ADDS_" ("_BOTTLE_")"
+8 IF $GET(AFLG)
SET ADDS=ADDS_", "_ADDNAM_" "_STRENGTH
if BOTTLE'=""
SET ADDS=ADDS_" ("_BOTTLE_")"
+9 if '$GET(AFLG)
SET AFLG=1
End DoDot:1
+10 if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
+11 IF '$GET(PSODUPF)
DO HD^PSODDPR2()
if $GET(PSODLQT)
QUIT
+12 IF $GET(AFLG)
IF '$GET(PSODUPF)
WRITE !,$JUSTIFY("Other Additives: ",23)
DO MYWRITE(ADDS,23,78)
+13 FOR
SET SOL=$ORDER(^TMP($JOB,SORT,ORDID,"SOL",SOL))
if SOL=""
QUIT
Begin DoDot:1
+14 SET (SOLUTION,VOLUME)=""
+15 SET (SOLUTION,VOLUME,IVDATA)=""
SET IVDATA=^TMP($JOB,SORT,ORDID,"SOL",SOL)
+16 SET VOLUME=$PIECE(IVDATA,"^",2)
SET SOLUTION=$PIECE(IVDATA,"^")
+17 if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
+18 if '$GET(SFLG)&'$GET(PSODUPF)
WRITE !,$JUSTIFY("Solution(s): ",23)_SOLUTION_" "_VOLUME_" "_INFUSE
+19 IF $GET(SFLG)
IF '$GET(PSODUPF)
WRITE !?23,SOLUTION_" "_VOLUME_" "_INFUSE
+20 if $GET(PSODUPF)
SET PSODUPC(ZCT)=PSODUPC(ZCT)+1
+21 SET SFLG=1
End DoDot:1
+22 IF '$GET(PSODUPF)
DO HD^PSODDPR2()
if $GET(PSODLQT)
QUIT
+23 QUIT
+24 ;
MYWRITE(X,DIWL,DIWR) ;Continue writing on the same line
+1 NEW DN,PSOCNT
+2 IF '$GET(DIWL)
SET DIWL=1
+3 IF '$GET(DIWR)
SET DIWR=75
+4 KILL ^UTILITY($JOB,"W")
DO ^DIWP
+5 FOR PSOCNT=0:0
SET PSOCNT=$ORDER(^UTILITY($JOB,"W",DIWL,PSOCNT))
if 'PSOCNT
QUIT
if PSOCNT'=1
WRITE !
WRITE ?DIWL,^UTILITY($JOB,"W",DIWL,PSOCNT,0)
+6 QUIT
NOCAN ;shows duplicate therapeutic when cancel duplicate class parameter is set to 'no'
+1 KILL ^UTILITY($JOB,"W"),DDTH,DOCPL,DIWF
SET DIWL=1
SET DIWR=78
SET DIWF=""
+2 NEW DUPCPF,PSODUPT,ZZOCTD,CLINTYP,CT,SUB,ZZOC
SET ZZOCTD=0
+3 ;PSO*7*411
SET (CT,SUB,ZZOC)=0
KILL TCT,TCTP,TCTL,TCTI,ZZQ,ZHDR
+4 FOR
SET CT=$ORDER(^TMP($JOB,LIST,"OUT","THERAPY",CT))
if 'CT
QUIT
FOR
SET SUB=$ORDER(^TMP($JOB,LIST,"OUT","THERAPY",CT,"DRUGS",SUB))
if 'SUB
QUIT
Begin DoDot:1
+5 SET ON=$PIECE(^TMP($JOB,LIST,"OUT","THERAPY",CT,"DRUGS",SUB),"^")
SET PDRG=$PIECE(^(SUB),"^",3)
SET RXREC=$PIECE(ON,";",2)
+6 IF $GET(PSODCTH(ON))
QUIT
+7 IF $PIECE(ON,";")="Z"
QUIT
+8 IF $PIECE(ON,";")="N"
IF $GET(^TMP($JOB,"PSONVADD",RXREC,0))
QUIT
+9 IF $PIECE(ON,";")="R"
IF $GET(^TMP($JOB,"PSORMDD",RXREC,0))
QUIT
+10 IF $PIECE(ON,";")="O"
IF $GET(^TMP("PSORXDC",$JOB,RXREC,0))
QUIT
+11 IF $PIECE(ON,";")="P"
IF $GET(^TMP("PSORXDC",$JOB,RXREC,0))
QUIT
+12 IF $PIECE(ON,";")="O"
IF $GET(^TMP("PSORXDD",$JOB,RXREC,0))
QUIT
+13 IF '$GET(ZHDR)
if (($Y+5)'>IOSL)
DO HD^PSODDPR2()
if $GET(PSODLQT)
QUIT
WRITE !,PSONULN,!,"*** THERAPEUTIC DUPLICATION(S) *** "_PSODRUG("NAME")_" with",!
SET ZHDR=1
End DoDot:1
+14 if '$GET(ZHDR)
QUIT
if $GET(PSODLQT)
QUIT
+15 NEW ST,STA,STAT,ORT,CT
KILL DOCPL
+16 SET (SUB,CT)=0
FOR
SET CT=$ORDER(^TMP($JOB,LIST,"OUT","THERAPY",CT))
if 'CT
QUIT
FOR
SET SUB=$ORDER(^TMP($JOB,LIST,"OUT","THERAPY",CT,"DRUGS",SUB))
if 'SUB
QUIT
DO DUPCL
KILL DDTH
+17 DO DUPCP
+18 if $DATA(ZPSODCTH)
SET ^TMP("PSODAOC",$JOB,"DT","T","A",50,PSODRUG("IEN"),0)=""
+19 QUIT
DUPCL ;
+1 SET ON=$PIECE(^TMP($JOB,LIST,"OUT","THERAPY",CT,"DRUGS",SUB),"^")
SET PDRG=$PIECE(^(SUB),"^",3)
SET RXREC=$PIECE(ON,";",2)
+2 IF $PIECE(ON,";")="Z"
QUIT
+3 IF $PIECE(ON,";")="N"
IF $GET(^TMP($JOB,"PSONVADD",RXREC,0))
QUIT
+4 IF $PIECE(ON,";")="R"
IF $GET(^TMP($JOB,"PSORMDD",RXREC,0))
QUIT
+5 IF $PIECE(ON,";")="O"
IF $GET(^TMP("PSORXDC",$JOB,RXREC,0))
QUIT
+6 IF $PIECE(ON,";")="P"
IF $GET(^TMP("PSORXDC",$JOB,RXREC,0))
QUIT
+7 IF $PIECE(ON,";")="O"
IF $GET(^TMP("PSORXDD",$JOB,RXREC,0))
QUIT
+8 SET ORT=$SELECT($PIECE(ON,";")="N":4,$PIECE(ON,";")="P":3,$PIECE(ON,";")="R":2,1:1)
+9 SET DOCPL(ORT,ON)=""
+10 QUIT
+11 ;
DUPCP if (($Y+5)'>IOSL)
DO HD^PSODDPR2()
SET ORT=0
SET ON=""
FOR
SET ORT=$ORDER(DOCPL(ORT))
if 'ORT!$GET(PSODLQT)
QUIT
FOR
SET ON=$ORDER(DOCPL(ORT,ON))
if ON=""!$GET(PSODLQT)
QUIT
Begin DoDot:1
+1 SET PSODUPT=""
+2 IF $PIECE(ON,";")="O"
SET PSODUPT="O"
Begin DoDot:2
+3 if (($Y+5)'>IOSL)
DO HD^PSODDPR2()
if $GET(PSODLQT)
QUIT
SET ST=$PIECE(^PSRX($PIECE(ON,";",2),"STA"),"^")+1
+4 SET STA="ACTIVE^NON-VERIFIED^REFILL^HOLD^NON-VERIFIED^SUSPENDED^^^^^^EXPIRED^DISCONTINUED^^DISCONTINUED BY PROVIDER^DISCONTINUE EDIT^PROVIDER HOLD"
+5 SET STAT=$PIECE(STA,"^",ST)
WRITE !?2,"Local Rx #"_$PIECE(^PSRX($PIECE(ON,";",2),0),"^")_" ("_STAT_") for "_$PIECE(^PSDRUG($PIECE(^PSRX($PIECE(ON,";",2),0),"^",6),0),"^")
End DoDot:2
+6 IF $PIECE(ON,";")="P"
SET PSODUPT="P"
Begin DoDot:2
+7 if (($Y+5)'>IOSL)
DO HD^PSODDPR2()
if $GET(PSODLQT)
QUIT
+8 SET RXREC=$PIECE(ON,";",2)
SET DNM=$PIECE(^PS(52.41,RXREC,0),"^",9)
+9 SET DUPRX0=^PS(52.41,RXREC,0)
+10 WRITE !?2,"Pending Order for "
+11 IF '$PIECE(DUPRX0,"^",9)
WRITE $PIECE(^PS(50.7,$PIECE(DUPRX0,"^",8),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")
+12 IF '$TEST
WRITE $PIECE(^PSDRUG($PIECE(DUPRX0,"^",9),0),"^")
End DoDot:2
+13 IF $PIECE(ON,";")="R"
SET PSODUPT="R"
NEW RXDAT
Begin DoDot:2
+14 if (($Y+5)'>IOSL)
DO HD^PSODDPR2()
if $GET(PSODLQT)
QUIT
+15 SET RXDAT=^TMP($JOB,LIST,"OUT","REMOTE",$PIECE(ON,";",2))
+16 SET RDIRX=$PIECE(RXDAT,"^",5)
if (($Y+5)'>IOSL)
DO HD^PSODDPR2()
if $GET(PSODLQT)
QUIT
WRITE !?2,"Remote Rx #"_RDIRX_" ("_$PIECE(RXDAT,"^",4)_") for "_$PIECE(RXDAT,"^",3)
End DoDot:2
+17 IF $PIECE(ON,";")="N"
SET PSODUPT="N"
Begin DoDot:2
+18 if '$DATA(^PS(55,PSODFN,"NVA",$PIECE(ON,";",2),0))
QUIT
+19 SET DUPRX0=^PS(55,PSODFN,"NVA",$PIECE(ON,";",2),0)
NEW NVAQ
+20 if (($Y+5)'>IOSL)
DO HD^PSODDPR2()
if $GET(PSODLQT)
QUIT
+21 WRITE !?2,"Non-VA Med for "
+22 IF '$PIECE(DUPRX0,"^",2)
WRITE $PIECE(^PS(50.7,$PIECE(DUPRX0,"^"),0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")
+23 IF '$TEST
WRITE $PIECE(^PSDRUG($PIECE(DUPRX0,"^",2),0),"^")
End DoDot:2
+24 IF $PIECE(ON,";")["C"
SET PSODUPT="C"
Begin DoDot:2
+25 ;CLINIC ORDERS ;1=55V,2=55U,3=531I,4=531U,5=531I
+26 NEW DRGNAME
SET DRGNAME=$PIECE($GET(^TMP($JOB,LIST,"IN","PROFILE",ON)),"^",4)
+27 SET (PSOCON,ORDID,ZCT,CLINTYP)=ON
SET DRGDRG=0
SET DUPCPF=1
SET SORT="PSOPEPS CLINIC"
DO CLINIC
+28 SET CLINTYP=$PIECE(^TMP($JOB,"PSOPEPS","IN","PROFILE",ON),"^",7)
+29 SET ZZOCTD=ZZOCTD+1
SET ZPSODCTH(ON)=$SELECT($PIECE(CLINTYP,";")[1:"V",$PIECE(CLINTYP,";")[3!($PIECE(CLINTYP,";")[4)!(($PIECE(CLINTYP,";")[5)):$EXTRACT($PIECE(ON,";",1),2)_";PS(53.1",1:"U")_";"_$PIECE(ON,";",2)
+30 SET ^TMP("PSODAOC",$JOB,"DT","T","A",70,ZZOCTD,0)=ZPSODCTH(ON)
+31 ;S ^TMP("PSODAOC",$J,"DT","T","A",70,"ADDITIVE",ZPSODCTH(ON),
End DoDot:2
+32 SET DDTH(ON)=1
+33 IF PSODUPT="R"
SET ZZOCTD=ZZOCTD+1
SET ZPSODCTH(ON)="R;"_$PIECE(ON,";",2)
SET ^TMP("PSODAOC",$JOB,"DT","T","A",70,ZZOCTD,0)=ZPSODCTH(ON)
+34 IF PSODUPT="N"
SET ZZOCTD=ZZOCTD+1
SET ZPSODCTH(ON)="N;"_$PIECE(ON,";",2)
SET ^TMP("PSODAOC",$JOB,"DT","T","A",70,ZZOCTD,0)=ZPSODCTH(ON)
+35 IF PSODUPT="P"
SET ZZOCTD=ZZOCTD+1
SET ZPSODCTH(ON)=$PIECE(ON,";",2)_";PS(52.41"
SET ^TMP("PSODAOC",$JOB,"DT","T","A",60,ZZOCTD,0)=ZPSODCTH(ON)
+36 IF PSODUPT="O"
SET ZZOCTD=ZZOCTD+1
SET ZPSODCTH(ON)=$PIECE(ON,";",2)_";PSRX("
SET ^TMP("PSODAOC",$JOB,"DT","T","A",60,ZZOCTD,0)=ZPSODCTH(ON)
+37 if $DATA(ZPSODCTH)
SET ^TMP("PSODAOC",$JOB,"DT","T","A",50,PSODRUG("IEN"),0)=""
End DoDot:1
+38 if (($Y+5)'>IOSL)
DO HD^PSODDPR2()
if $GET(PSODLQT)
QUIT
+39 DO CLASSES^PSODDPR3
+40 NEW X,ZZCT
SET (ZCT,ZZCT)=0
+41 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
+42 SET X=^TMP($JOB,LIST,"OUT","THERAPY",ZZCT,ZCT,"CLASS")
+43 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:"")
+44 IF $GET(X)]""
SET ^TMP("PSODAOC",$JOB,"DT","T","A","CL",ZZCT,0)=X
End DoDot:1
+45 DO HD^PSODDPR2(0,1)
if $GET(PSODLQT)
QUIT
+46 QUIT
