- 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 Feb 18, 2025@23:52:56 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