- PSJDIN ;BIR/MV - National Formulary Indicator Utility ;4 MAR 2000/ 4:27 PM
- ;;5.0;INPATIENT MEDICATIONS;**50,56,76,227,289**;16 DEC 97;Build 2
- ;
- ; Reference to ^PSSDIN is supported by DBIA# 3166.
- ; Reference to ^PS(52.6 is supported by DBIA# 1231.
- ; Reference to ^PS(52.7 is supported by DBIA# 2173.
- ; Reference to ^PS(50.7 is supported by DBIA# 2180.
- ; Reference tp ^PSDRUG is supported by DBIA# 2192.
- ;
- DINIV(FIL,DRGTMP) ;
- ;*Find the DD & OI IEN for the additive or solution
- ;*FIL: 52.6 or 52.7
- ;*DRGTMP: Additive or Solution's IEN
- ;
- NEW PSJDRG,PSJOI,PSJDD,PSJDIN,PSJINDEX
- S PSJDRG=$P(^PS(FIL,+DRGTMP,0),U,2),PSJOI=$P(^PS(FIL,+DRGTMP,0),U,11)
- D DIN(PSJOI,PSJDRG)
- Q
- DIN(PSJOI,PSJDRG) ;
- ;*This will issue the Restriction/guideline prompt for both OI & DD
- ;*PSJOI: Orderable Item IEN
- ;*PSJDRG: Dispense drug IEN
- ;
- NEW PSJDIN,PSJDD,PSJINDEX,Y,X,XIT
- D EN^PSSDIN(PSJOI,PSJDRG)
- Q:$O(^TMP("PSSDIN",$J,""))=""
- S PSJDIN=$$PROMPT^PSSDIN
- W:"DOY"[Y @IOF
- I PSJDIN="D"!(PSJDIN="Y") D Q:XIT=U
- . W !!,"Dispense Drug Text:" W ! D TXD("DD") W !!
- I PSJDIN="O"!(PSJDIN="Y") D
- . W !!,"Orderable Item Text:" W ! D TXD("OI") W !!
- D PAUSE^VALM1,CLEAR^VALM1
- Q
- TXD(N1) ;
- ;N1 = "OI" or "DD"
- ;DISPLAY OI/DD DRUG TEXT
- N N2,N3,N4,NX S XIT="",NX="PSSDIN" ;
- S N2="" F S N2=$O(^TMP(NX,$J,N1,N2)) Q:'N2!(XIT=U) D
- .S N3="" F S N3=$O(^TMP(NX,$J,N1,N2,N3)) Q:'N3!(XIT=U) D
- ..S N4="" F S N4=$O(^TMP(NX,$J,N1,N2,N3,N4)) Q:'N4!(XIT=U) D
- ...W !?5,^TMP(NX,$J,N1,N2,N3,N4) I $Y>15 W ! D HLD S XIT=X
- Q
- HLD ;
- W !
- ;K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR
- K DIR
- S DIR(0)="E",DIR("A")="Press Return to Continue or ""^"" to Exit: "
- D ^DIR K DIR
- W @IOF
- Q
- NFIV(FIL,PSJIVIEN,PSJNF) ;
- ;*Return N/F and msg display for ad/sol.
- ;*FIL: "AD" or "SOL"
- ;*PSIVIEN: Additive or Solution's IEN
- ;*PSJNF: 0 node from file 50
- ;*PSJNF("NF"): Only exist if it is a Non-formulary
- ;*PSJNF("MSG"): Return the message field to be displayed /w IV names
- ;
- S PSJNF=$G(^PSDRUG(+$P($G(^PS(FIL,+PSJIVIEN,0)),U,2),0))
- S PSJNF("NF")=$S($P(PSJNF,U,9)=1:" *N/F*",1:"")
- S PSJNF("MSG")=$P(PSJNF,U,10)
- Q
- DINFLIV(DRG) ;
- ;*This module will find all drug text that exist for the Orderable
- ;*Items & dispense drugs associated with the Additive(s) & Solution(s)
- ;*within the IV order. Once a drug text exist, return the <DIN>
- ;*indicator to be displayed within the order view.
- ;
- ;*DRG: Drug array from the IV order
- NEW PSJFIL,PSJND,PSJX,PSJFL
- F PSJFIL="AD","SOL" F PSJND=0:0 S PSJND=$O(DRG(PSJFIL,PSJND)) Q:'PSJND!$G(PSJFL) D
- . S PSJX=$G(^PS($S(PSJFIL="AD":52.6,1:52.7),+DRG(PSJFIL,PSJND),0)) D EN^PSSDIN($P(PSJX,U,11),$P(PSJX,U,2))
- . I $O(^TMP("PSSDIN",$J,""))]"" S PSJFL=1 Q
- I '$G(PSJFL),$G(PSJORD)["P" S PSJFL=$$DINFLUD(+P("PD")),PSJFL=$S(PSJFL]"":1,1:0)
- K ^TMP("PSSDIN",$J)
- Q $S($G(PSJFL):" <DIN>",1:"")
- ;
- DINFLUD(PSJOI,PSJDDA) ;
- ;*This module will find all drug text that exist for the Orderable
- ;*items & dispense drugs associated with the unit dose order. Once
- ;*a drug text exist, return the <DIN> indicator to be displayed with
- ;*the order view.
- ;*PSJOI: Orderable IEN (Require)
- ;*PSJDDA: Dispense drug array within the order (Optional)
- ;
- NEW PSJFL,PSJDD
- D EN^PSSDIN(PSJOI) I $O(^TMP("PSSDIN",$J,"OI",0)) K ^TMP("PSSDIN",$J) Q "<DIN>"
- F PSJDD=0:0 S PSJDD=$O(PSJDDA(PSJDD)) Q:'PSJDD D
- . D EN^PSSDIN(,PSJDD) I $O(^TMP("PSSDIN",$J,"DD",0)) S PSJFL=1 Q
- K ^TMP("PSSDIN",$J)
- Q $S($G(PSJFL):"<DIN>",1:"")
- ;
- DINHIDE(PSJDFN,PSJORD) ;
- ;*Display drug text from the hidden action.
- ;*PSJDFN: Patient IEN (Require)
- ;*PSJORD: Order #_"UVP" (Required)
- ;*DRG: IV DRG array (Required for IV but Optional for UD orders)
- ;
- D:PSJORD["V" IV
- D:PSJORD["U" UD
- I PSJORD["P" D
- . D @($S($P(^PS(53.1,+PSJORD,0),U,4)="U":"UD",1:"IV")) ;PSJ*5*227 - Unit Dose DIN fix
- I PSJORD="" D NEWUD
- K ^TMP("PSSDIN",$J)
- Q
- IV ;
- ;NEW DRG,DRGI,DRGT,ND,ON55,Y
- ;D:PSJORD["P" GT531^PSIVORFA(DFN,PSJORD)
- ;I PSJORD["V" S ON55=PSJORD D GTDRG^PSIVORFB
- ;*Loop thru IV DRG array to find OI & DD IEN from each AD & SOL.
- ;
- NEW FIL,NAME,PSJDD,PSJNF,PSJOI,PSJX,Y,X,PSJXY,STR,UNT,STRUN
- D FULL^VALM1 W @IOF
- W !,"Drug restriction/guideline info:"
- F FIL="AD","SOL" F PSJX=0:0 S PSJX=$O(DRG(FIL,PSJX)) Q:'PSJX D
- . NEW X
- . S PSJXY=1
- . SET NAME=$P(DRG(FIL,PSJX),U,2)
- . ;PSJ*5*289 - Add Additive Strength to display.
- . S STR=$$GET1^DIQ(52.6,$P(DRG(FIL,PSJX),U,1)_",",19) ; Get STRENGTH from IV Additives File
- . S UNT=$$GET1^DIQ(52.6,$P(DRG(FIL,PSJX),U,1)_",",2) ; Get DRUG UNIT from IV Additives File
- . S STRUN=$G(STR)_" "_$G(UNT) ; Append DRUG UNIT to STRENGTH
- . I STR="" S STRUN="N/A" ; Per Pharmacy User Group - put N/A if the STRENGTH field is not populated.
- . W !!,"IV "_$S(FIL="AD":"Additive",1:"Solution")_": "_NAME
- . D NFIV(FIL,+PSJX,.PSJNF) W $G(PSJNF("NF"))_$S(FIL="AD":" Additive Strength: "_$G(STRUN),1:""),! ;Put Additive Strength after *N/F*.
- . S X=$S(FIL="AD":$G(^PS(52.6,+DRG(FIL,PSJX),0)),1:$G(^PS(52.7,+DRG(FIL,PSJX),0)))
- . S PSJOI=$P(X,U,11),PSJDD=$P(X,U,2) D EN^PSSDIN(+PSJOI,+PSJDD)
- . D DINOI(PSJOI,3)
- . D DINDD(PSJDD,3)
- D:'$G(PSJXY) HLD
- K ^TMP("PSSDIN",$J)
- Q
- UD ;
- ;*Loop thru Unit dose order for Orderable Item & Dispense drug
- ;
- NEW F,PSJDD,PSJDDX,PSJOI,PSJXY
- D FULL^VALM1 W @IOF
- W !,"Drug restriction/guideline info:"
- S F=$S(PSJORD["U":"^PS(55,PSJDFN,5,+PSJORD,",1:"^PS(53.1,+PSJORD,")
- S PSJOI=+@(F_".2)") D EN^PSSDIN(PSJOI),DINOI(PSJOI,3)
- ;*Loop thru dispense drug array
- F PSJDDX=0:0 S PSJDDX=$O(@(F_"1,"_PSJDDX_")")) Q:'PSJDDX D
- . S PSJXY=1
- . S PSJDD=+@(F_"1,"_PSJDDX_",0)")
- . D EN^PSSDIN(PSJOI,PSJDD)
- . D DINDD(PSJDD,3)
- D:'$G(PSJXY) HLD
- K ^TMP("PSSDIN",$J)
- Q
- NEWUD ;*New backdoor order doesn't have an order# yet.
- ;*Loop thru Orderable Item & Dispense drug
- ;
- NEW F,PSJDD,PSJDDX,PSJOI,PSJXY
- D FULL^VALM1 W @IOF
- W !,"Drug restriction/guideline info:"
- S PSJOI=+$G(PSGPD) D EN^PSSDIN(PSJOI),DINOI(PSJOI,3)
- ;*Loop thru dispense drug array
- F PSJDDX=0:0 S PSJDDX=$O(^PS(53.45,PSJSYSP,2,PSJDDX)) Q:'PSJDDX D
- . S PSJXY=1
- . S PSJDD=+$G(^PS(53.45,PSJSYSP,2,PSJDDX,0))
- . D EN^PSSDIN(PSJOI,PSJDD)
- . D DINDD(PSJDD,3)
- D:'$G(PSJXY) HLD
- K ^TMP("PSSDIN",$J)
- Q
- DINOI(PSJOI,COL) ;
- ;*Display drug text for Orderable Item
- ;*OI: Orderable Item IEN
- ;*COl: Column to display the text in
- ;
- NEW X,XX
- W !!,?COL,"Orderable Item: "_$$OINAME^PSJLMUTL(PSJOI)_$$OINF(PSJOI),!
- I '$O(^TMP("PSSDIN",$J,"OI",PSJOI,0)) W !,?10,"No information available",! Q
- D TXD("OI") W !
- Q
- DINDD(PSJDD,COL) ;
- ;*Display drug text for Dispense drug
- ;*PSJDD: Dispense drug IEN
- ;*COL: Column to display the text in
- ;
- NEW X
- W !,?COL,"Dispense drug: "_$$DDNAME^PSJLMUTL(+PSJDD)_$$DDNF(PSJDD),!
- I '$O(^TMP("PSSDIN",$J,"DD",PSJDD,0)) W !?10,"No information available",! D HLD Q
- D TXD("DD"),HLD W @IOF
- Q
- OINF(PSJOI) ;
- ;*Return *N/F* if the orderable item is Non-formulary
- ;*PSJOI: Orderable item IEN
- ;
- Q $S($P($G(^PS(50.7,+PSJOI,0)),U,12)=1:" *N/F*",1:"")
- ;
- DDNF(PSJDD) ;
- ;**Return *N/F* if the dispense drug is Non-formulary
- ;*PSJDD: Dispense drug IEN
- ;
- Q $S($P($G(^PSDRUG(+PSJDD,0)),U,9)=1:" *N/F*",1:"")
-
-
-
-
-
-
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJDIN 7366 printed Feb 18, 2025@23:33:05 Page 2
- PSJDIN ;BIR/MV - National Formulary Indicator Utility ;4 MAR 2000/ 4:27 PM
- +1 ;;5.0;INPATIENT MEDICATIONS;**50,56,76,227,289**;16 DEC 97;Build 2
- +2 ;
- +3 ; Reference to ^PSSDIN is supported by DBIA# 3166.
- +4 ; Reference to ^PS(52.6 is supported by DBIA# 1231.
- +5 ; Reference to ^PS(52.7 is supported by DBIA# 2173.
- +6 ; Reference to ^PS(50.7 is supported by DBIA# 2180.
- +7 ; Reference tp ^PSDRUG is supported by DBIA# 2192.
- +8 ;
- DINIV(FIL,DRGTMP) ;
- +1 ;*Find the DD & OI IEN for the additive or solution
- +2 ;*FIL: 52.6 or 52.7
- +3 ;*DRGTMP: Additive or Solution's IEN
- +4 ;
- +5 NEW PSJDRG,PSJOI,PSJDD,PSJDIN,PSJINDEX
- +6 SET PSJDRG=$PIECE(^PS(FIL,+DRGTMP,0),U,2)
- SET PSJOI=$PIECE(^PS(FIL,+DRGTMP,0),U,11)
- +7 DO DIN(PSJOI,PSJDRG)
- +8 QUIT
- DIN(PSJOI,PSJDRG) ;
- +1 ;*This will issue the Restriction/guideline prompt for both OI & DD
- +2 ;*PSJOI: Orderable Item IEN
- +3 ;*PSJDRG: Dispense drug IEN
- +4 ;
- +5 NEW PSJDIN,PSJDD,PSJINDEX,Y,X,XIT
- +6 DO EN^PSSDIN(PSJOI,PSJDRG)
- +7 if $ORDER(^TMP("PSSDIN",$JOB,""))=""
- QUIT
- +8 SET PSJDIN=$$PROMPT^PSSDIN
- +9 if "DOY"[Y
- WRITE @IOF
- +10 IF PSJDIN="D"!(PSJDIN="Y")
- Begin DoDot:1
- +11 WRITE !!,"Dispense Drug Text:"
- WRITE !
- DO TXD("DD")
- WRITE !!
- End DoDot:1
- if XIT=U
- QUIT
- +12 IF PSJDIN="O"!(PSJDIN="Y")
- Begin DoDot:1
- +13 WRITE !!,"Orderable Item Text:"
- WRITE !
- DO TXD("OI")
- WRITE !!
- End DoDot:1
- +14 DO PAUSE^VALM1
- DO CLEAR^VALM1
- +15 QUIT
- TXD(N1) ;
- +1 ;N1 = "OI" or "DD"
- +2 ;DISPLAY OI/DD DRUG TEXT
- +3 ;
- NEW N2,N3,N4,NX
- SET XIT=""
- SET NX="PSSDIN"
- +4 SET N2=""
- FOR
- SET N2=$ORDER(^TMP(NX,$JOB,N1,N2))
- if 'N2!(XIT=U)
- QUIT
- Begin DoDot:1
- +5 SET N3=""
- FOR
- SET N3=$ORDER(^TMP(NX,$JOB,N1,N2,N3))
- if 'N3!(XIT=U)
- QUIT
- Begin DoDot:2
- +6 SET N4=""
- FOR
- SET N4=$ORDER(^TMP(NX,$JOB,N1,N2,N3,N4))
- if 'N4!(XIT=U)
- QUIT
- Begin DoDot:3
- +7 WRITE !?5,^TMP(NX,$JOB,N1,N2,N3,N4)
- IF $Y>15
- WRITE !
- DO HLD
- SET XIT=X
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +8 QUIT
- HLD ;
- +1 WRITE !
- +2 ;K DIR S DIR(0)="E",DIR("A")="Press Return to Continue" D ^DIR K DIR
- +3 KILL DIR
- +4 SET DIR(0)="E"
- SET DIR("A")="Press Return to Continue or ""^"" to Exit: "
- +5 DO ^DIR
- KILL DIR
- +6 WRITE @IOF
- +7 QUIT
- NFIV(FIL,PSJIVIEN,PSJNF) ;
- +1 ;*Return N/F and msg display for ad/sol.
- +2 ;*FIL: "AD" or "SOL"
- +3 ;*PSIVIEN: Additive or Solution's IEN
- +4 ;*PSJNF: 0 node from file 50
- +5 ;*PSJNF("NF"): Only exist if it is a Non-formulary
- +6 ;*PSJNF("MSG"): Return the message field to be displayed /w IV names
- +7 ;
- +8 SET PSJNF=$GET(^PSDRUG(+$PIECE($GET(^PS(FIL,+PSJIVIEN,0)),U,2),0))
- +9 SET PSJNF("NF")=$SELECT($PIECE(PSJNF,U,9)=1:" *N/F*",1:"")
- +10 SET PSJNF("MSG")=$PIECE(PSJNF,U,10)
- +11 QUIT
- DINFLIV(DRG) ;
- +1 ;*This module will find all drug text that exist for the Orderable
- +2 ;*Items & dispense drugs associated with the Additive(s) & Solution(s)
- +3 ;*within the IV order. Once a drug text exist, return the <DIN>
- +4 ;*indicator to be displayed within the order view.
- +5 ;
- +6 ;*DRG: Drug array from the IV order
- +7 NEW PSJFIL,PSJND,PSJX,PSJFL
- +8 FOR PSJFIL="AD","SOL"
- FOR PSJND=0:0
- SET PSJND=$ORDER(DRG(PSJFIL,PSJND))
- if 'PSJND!$GET(PSJFL)
- QUIT
- Begin DoDot:1
- +9 SET PSJX=$GET(^PS($SELECT(PSJFIL="AD":52.6,1:52.7),+DRG(PSJFIL,PSJND),0))
- DO EN^PSSDIN($PIECE(PSJX,U,11),$PIECE(PSJX,U,2))
- +10 IF $ORDER(^TMP("PSSDIN",$JOB,""))]""
- SET PSJFL=1
- QUIT
- End DoDot:1
- +11 IF '$GET(PSJFL)
- IF $GET(PSJORD)["P"
- SET PSJFL=$$DINFLUD(+P("PD"))
- SET PSJFL=$SELECT(PSJFL]"":1,1:0)
- +12 KILL ^TMP("PSSDIN",$JOB)
- +13 QUIT $SELECT($GET(PSJFL):" <DIN>",1:"")
- +14 ;
- DINFLUD(PSJOI,PSJDDA) ;
- +1 ;*This module will find all drug text that exist for the Orderable
- +2 ;*items & dispense drugs associated with the unit dose order. Once
- +3 ;*a drug text exist, return the <DIN> indicator to be displayed with
- +4 ;*the order view.
- +5 ;*PSJOI: Orderable IEN (Require)
- +6 ;*PSJDDA: Dispense drug array within the order (Optional)
- +7 ;
- +8 NEW PSJFL,PSJDD
- +9 DO EN^PSSDIN(PSJOI)
- IF $ORDER(^TMP("PSSDIN",$JOB,"OI",0))
- KILL ^TMP("PSSDIN",$JOB)
- QUIT "<DIN>"
- +10 FOR PSJDD=0:0
- SET PSJDD=$ORDER(PSJDDA(PSJDD))
- if 'PSJDD
- QUIT
- Begin DoDot:1
- +11 DO EN^PSSDIN(,PSJDD)
- IF $ORDER(^TMP("PSSDIN",$JOB,"DD",0))
- SET PSJFL=1
- QUIT
- End DoDot:1
- +12 KILL ^TMP("PSSDIN",$JOB)
- +13 QUIT $SELECT($GET(PSJFL):"<DIN>",1:"")
- +14 ;
- DINHIDE(PSJDFN,PSJORD) ;
- +1 ;*Display drug text from the hidden action.
- +2 ;*PSJDFN: Patient IEN (Require)
- +3 ;*PSJORD: Order #_"UVP" (Required)
- +4 ;*DRG: IV DRG array (Required for IV but Optional for UD orders)
- +5 ;
- +6 if PSJORD["V"
- DO IV
- +7 if PSJORD["U"
- DO UD
- +8 IF PSJORD["P"
- Begin DoDot:1
- +9 ;PSJ*5*227 - Unit Dose DIN fix
- DO @($SELECT($PIECE(^PS(53.1,+PSJORD,0),U,4)="U":"UD",1:"IV"))
- End DoDot:1
- +10 IF PSJORD=""
- DO NEWUD
- +11 KILL ^TMP("PSSDIN",$JOB)
- +12 QUIT
- IV ;
- +1 ;NEW DRG,DRGI,DRGT,ND,ON55,Y
- +2 ;D:PSJORD["P" GT531^PSIVORFA(DFN,PSJORD)
- +3 ;I PSJORD["V" S ON55=PSJORD D GTDRG^PSIVORFB
- +4 ;*Loop thru IV DRG array to find OI & DD IEN from each AD & SOL.
- +5 ;
- +6 NEW FIL,NAME,PSJDD,PSJNF,PSJOI,PSJX,Y,X,PSJXY,STR,UNT,STRUN
- +7 DO FULL^VALM1
- WRITE @IOF
- +8 WRITE !,"Drug restriction/guideline info:"
- +9 FOR FIL="AD","SOL"
- FOR PSJX=0:0
- SET PSJX=$ORDER(DRG(FIL,PSJX))
- if 'PSJX
- QUIT
- Begin DoDot:1
- +10 NEW X
- +11 SET PSJXY=1
- +12 SET NAME=$PIECE(DRG(FIL,PSJX),U,2)
- +13 ;PSJ*5*289 - Add Additive Strength to display.
- +14 ; Get STRENGTH from IV Additives File
- SET STR=$$GET1^DIQ(52.6,$PIECE(DRG(FIL,PSJX),U,1)_",",19)
- +15 ; Get DRUG UNIT from IV Additives File
- SET UNT=$$GET1^DIQ(52.6,$PIECE(DRG(FIL,PSJX),U,1)_",",2)
- +16 ; Append DRUG UNIT to STRENGTH
- SET STRUN=$GET(STR)_" "_$GET(UNT)
- +17 ; Per Pharmacy User Group - put N/A if the STRENGTH field is not populated.
- IF STR=""
- SET STRUN="N/A"
- +18 WRITE !!,"IV "_$SELECT(FIL="AD":"Additive",1:"Solution")_": "_NAME
- +19 ;Put Additive Strength after *N/F*.
- DO NFIV(FIL,+PSJX,.PSJNF)
- WRITE $GET(PSJNF("NF"))_$SELECT(FIL="AD":" Additive Strength: "_$GET(STRUN),1:""),!
- +20 SET X=$SELECT(FIL="AD":$GET(^PS(52.6,+DRG(FIL,PSJX),0)),1:$GET(^PS(52.7,+DRG(FIL,PSJX),0)))
- +21 SET PSJOI=$PIECE(X,U,11)
- SET PSJDD=$PIECE(X,U,2)
- DO EN^PSSDIN(+PSJOI,+PSJDD)
- +22 DO DINOI(PSJOI,3)
- +23 DO DINDD(PSJDD,3)
- End DoDot:1
- +24 if '$GET(PSJXY)
- DO HLD
- +25 KILL ^TMP("PSSDIN",$JOB)
- +26 QUIT
- UD ;
- +1 ;*Loop thru Unit dose order for Orderable Item & Dispense drug
- +2 ;
- +3 NEW F,PSJDD,PSJDDX,PSJOI,PSJXY
- +4 DO FULL^VALM1
- WRITE @IOF
- +5 WRITE !,"Drug restriction/guideline info:"
- +6 SET F=$SELECT(PSJORD["U":"^PS(55,PSJDFN,5,+PSJORD,",1:"^PS(53.1,+PSJORD,")
- +7 SET PSJOI=+@(F_".2)")
- DO EN^PSSDIN(PSJOI)
- DO DINOI(PSJOI,3)
- +8 ;*Loop thru dispense drug array
- +9 FOR PSJDDX=0:0
- SET PSJDDX=$ORDER(@(F_"1,"_PSJDDX_")"))
- if 'PSJDDX
- QUIT
- Begin DoDot:1
- +10 SET PSJXY=1
- +11 SET PSJDD=+@(F_"1,"_PSJDDX_",0)")
- +12 DO EN^PSSDIN(PSJOI,PSJDD)
- +13 DO DINDD(PSJDD,3)
- End DoDot:1
- +14 if '$GET(PSJXY)
- DO HLD
- +15 KILL ^TMP("PSSDIN",$JOB)
- +16 QUIT
- NEWUD ;*New backdoor order doesn't have an order# yet.
- +1 ;*Loop thru Orderable Item & Dispense drug
- +2 ;
- +3 NEW F,PSJDD,PSJDDX,PSJOI,PSJXY
- +4 DO FULL^VALM1
- WRITE @IOF
- +5 WRITE !,"Drug restriction/guideline info:"
- +6 SET PSJOI=+$GET(PSGPD)
- DO EN^PSSDIN(PSJOI)
- DO DINOI(PSJOI,3)
- +7 ;*Loop thru dispense drug array
- +8 FOR PSJDDX=0:0
- SET PSJDDX=$ORDER(^PS(53.45,PSJSYSP,2,PSJDDX))
- if 'PSJDDX
- QUIT
- Begin DoDot:1
- +9 SET PSJXY=1
- +10 SET PSJDD=+$GET(^PS(53.45,PSJSYSP,2,PSJDDX,0))
- +11 DO EN^PSSDIN(PSJOI,PSJDD)
- +12 DO DINDD(PSJDD,3)
- End DoDot:1
- +13 if '$GET(PSJXY)
- DO HLD
- +14 KILL ^TMP("PSSDIN",$JOB)
- +15 QUIT
- DINOI(PSJOI,COL) ;
- +1 ;*Display drug text for Orderable Item
- +2 ;*OI: Orderable Item IEN
- +3 ;*COl: Column to display the text in
- +4 ;
- +5 NEW X,XX
- +6 WRITE !!,?COL,"Orderable Item: "_$$OINAME^PSJLMUTL(PSJOI)_$$OINF(PSJOI),!
- +7 IF '$ORDER(^TMP("PSSDIN",$JOB,"OI",PSJOI,0))
- WRITE !,?10,"No information available",!
- QUIT
- +8 DO TXD("OI")
- WRITE !
- +9 QUIT
- DINDD(PSJDD,COL) ;
- +1 ;*Display drug text for Dispense drug
- +2 ;*PSJDD: Dispense drug IEN
- +3 ;*COL: Column to display the text in
- +4 ;
- +5 NEW X
- +6 WRITE !,?COL,"Dispense drug: "_$$DDNAME^PSJLMUTL(+PSJDD)_$$DDNF(PSJDD),!
- +7 IF '$ORDER(^TMP("PSSDIN",$JOB,"DD",PSJDD,0))
- WRITE !?10,"No information available",!
- DO HLD
- QUIT
- +8 DO TXD("DD")
- DO HLD
- WRITE @IOF
- +9 QUIT
- OINF(PSJOI) ;
- +1 ;*Return *N/F* if the orderable item is Non-formulary
- +2 ;*PSJOI: Orderable item IEN
- +3 ;
- +4 QUIT $SELECT($PIECE($GET(^PS(50.7,+PSJOI,0)),U,12)=1:" *N/F*",1:"")
- +5 ;
- DDNF(PSJDD) ;
- +1 ;**Return *N/F* if the dispense drug is Non-formulary
- +2 ;*PSJDD: Dispense drug IEN
- +3 ;
- +4 QUIT $SELECT($PIECE($GET(^PSDRUG(+PSJDD,0)),U,9)=1:" *N/F*",1:"")
- +5 +6 +7 +8 +9 +10