- PSONFI ;BIR/MHA - dispense drug/orderable item text display ;09/13/00
- ;;7.0;OUTPATIENT PHARMACY;**46,94,131,225,391,700,746**;DEC 1997;Build 106
- ;External reference to PSSDIN is supported by DBIA 3166
- ;External reference to ^PS(50.606 is supported by DBIA 2174
- ;External reference to ^PS(50.7 is supported by DBIA 2223
- ;External reference to ^PSDRUG( is supported by DBIA 221
- ;
- NFI ;display restriction/guidelines
- D EN^PSSDIN(PSODRUG("OI"),PSODRUG("IEN")) S NFI=$$PROMPT^PSSDIN
- I NFI]"","ODY"[NFI D TD^PSONFI S DIR(0)="E" D ^DIR K DIR
- K NFI Q
- DDTX ;Display drug text for the hidden action DIN
- N OI,DD
- S:$D(PSODRUG("OI")) OI=PSODRUG("OI") S:$D(PSODRUG("IEN")) DD=PSODRUG("IEN")
- I $G(OI),$G(DD) G 1
- I $D(PSORNSV),$G(PSORNSV)]"" S OI=+$P(OR0,"^",8),DD=+$P(OR0,"^",9) G 1
- S OI=+RXOR,DD=+$P(RX0,"^",6)
- 1 S OI=$S($G(OI):OI,1:""),DD=$S($G(DD):DD,1:"")
- D EN^PSSDIN(OI,DD)
- N N1,N2,N3,N4,TX,NX S NX="PSSDIN"
- W @IOF,!!,"Drug restriction/guideline info:",!!
- W !,"Orderable Item: "_$P(^PS(50.7,OI,0),"^")_" "_$P(^PS(50.606,$P(^(0),"^",2),0),"^")_$S($P(^PS(50.7,OI,0),"^",12):" ***(N/F)***",1:""),!!
- I $O(^TMP("PSSDIN",$J,"OI",0)) S N1="OI" D TXD
- W:'$O(^TMP("PSSDIN",$J,"OI",0)) ?5,"No information available ",!!
- I $G(DD),$D(^PSDRUG(DD,0)) W !,"Drug: "_$P(^PSDRUG(DD,0),"^")_$S($P(^PSDRUG(DD,0),"^",9):" ***(N/F)***",1:""),!! D
- .I $O(^TMP("PSSDIN",$J,"DD",0)) S N1="DD" D TXD
- .W:'$O(^TMP("PSSDIN",$J,"DD",0)) ?5,"No information available ",!!
- HLD K DIR S DIR(0)="E" D ^DIR K DIR
- Q
- DIN(OI,DD) ;Setup DIN indicator
- S (NFIO,NFID)=""
- I $D(OI),$G(OI) S:$P($G(^PS(50.7,OI,0)),"^",12) NFIO=" ***(N/F)***"
- I $D(DD),$G(DD) S:$P($G(^PSDRUG(DD,0)),"^",9) NFID=" ***(N/F)***"
- D EN^PSSDIN(OI,DD)
- S:$O(^TMP("PSSDIN",$J,"OI",0)) NFIO=NFIO_" <DIN>"
- S:$O(^TMP("PSSDIN",$J,"DD",0)) NFID=NFID_" <DIN>"
- K ^TMP("PSSDIN",$J) Q
- Q
- RV ;reverse video
- ; Saves Normal Line formatting
- I $G(VALMCNT)>$G(LASTLINE) D
- . I $D(VALMEVL) F L=($G(LASTLINE)+1):1:VALMCNT D SAVE^VALM10(L)
- . S LASTLINE=VALMCNT
- ;
- I '$D(IORVON)!'$D(IORVOFF) Q
- I $G(PKID),$G(PKIE)]"" D CNTRL^VALM10(1,1,$L(PKIE),IORVON,IORVOFF,0)
- D:$G(NFIO) CNTRL^VALM10(+NFIO,$P(NFIO,",",2),5,IORVON,IORVOFF,0)
- D:$G(NFID) CNTRL^VALM10(+NFID,$P(NFID,",",2),5,IORVON,IORVOFF,0)
- K NFIO,NFID,PKID
- ;- Reverses video for the words "Flagged" and "Unflagged"
- N L
- F L=1:1:$G(VALMCNT) D
- . D:$D(FLAGLINE(L)) CNTRL^VALM10(L,1,FLAGLINE(L),IORVON,IORVOFF,0)
- ; eRx Formatting
- D VIDEO^PSOERUT0()
- Q
- ;
- TD N N1,N2,N3,N4,TX,NX S NX="PSSDIN"
- W @IOF
- I NFI="O" D OIT
- I NFI="D" D DDT
- I NFI="Y" D DDT,OIT
- Q
- OIT ;
- S N1="OI",TX="Orderable Item Text:" D TXT
- Q
- DDT ;
- S N1="DD",TX="Dispense Drug Text:" D TXT
- Q
- TXT ;
- W !,TX
- TXD K ^UTILITY($J,"W")
- S N2="" F S N2=$O(^TMP(NX,$J,N1,N2)) Q:'N2!($D(DIRUT)) D
- .S N3="" F S N3=$O(^TMP(NX,$J,N1,N2,N3)) Q:'N3!($D(DIRUT)) D
- ..S N4="" F S N4=$O(^TMP(NX,$J,N1,N2,N3,N4)) Q:'N4!($D(DIRUT)) D
- ...W !?5,^TMP(NX,$J,N1,N2,N3,N4) I $Y>20 W ! D HLD Q:$D(DIRUT) W @IOF
- W ! K ^UTILITY($J,"W")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSONFI 3056 printed Jan 18, 2025@03:32:38 Page 2
- PSONFI ;BIR/MHA - dispense drug/orderable item text display ;09/13/00
- +1 ;;7.0;OUTPATIENT PHARMACY;**46,94,131,225,391,700,746**;DEC 1997;Build 106
- +2 ;External reference to PSSDIN is supported by DBIA 3166
- +3 ;External reference to ^PS(50.606 is supported by DBIA 2174
- +4 ;External reference to ^PS(50.7 is supported by DBIA 2223
- +5 ;External reference to ^PSDRUG( is supported by DBIA 221
- +6 ;
- NFI ;display restriction/guidelines
- +1 DO EN^PSSDIN(PSODRUG("OI"),PSODRUG("IEN"))
- SET NFI=$$PROMPT^PSSDIN
- +2 IF NFI]""
- IF "ODY"[NFI
- DO TD^PSONFI
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +3 KILL NFI
- QUIT
- DDTX ;Display drug text for the hidden action DIN
- +1 NEW OI,DD
- +2 if $DATA(PSODRUG("OI"))
- SET OI=PSODRUG("OI")
- if $DATA(PSODRUG("IEN"))
- SET DD=PSODRUG("IEN")
- +3 IF $GET(OI)
- IF $GET(DD)
- GOTO 1
- +4 IF $DATA(PSORNSV)
- IF $GET(PSORNSV)]""
- SET OI=+$PIECE(OR0,"^",8)
- SET DD=+$PIECE(OR0,"^",9)
- GOTO 1
- +5 SET OI=+RXOR
- SET DD=+$PIECE(RX0,"^",6)
- 1 SET OI=$SELECT($GET(OI):OI,1:"")
- SET DD=$SELECT($GET(DD):DD,1:"")
- +1 DO EN^PSSDIN(OI,DD)
- +2 NEW N1,N2,N3,N4,TX,NX
- SET NX="PSSDIN"
- +3 WRITE @IOF,!!,"Drug restriction/guideline info:",!!
- +4 WRITE !,"Orderable Item: "_$PIECE(^PS(50.7,OI,0),"^")_" "_$PIECE(^PS(50.606,$PIECE(^(0),"^",2),0),"^")_$SELECT($PIECE(^PS(50.7,OI,0),"^",12):" ***(N/F)***",1:""),!!
- +5 IF $ORDER(^TMP("PSSDIN",$JOB,"OI",0))
- SET N1="OI"
- DO TXD
- +6 if '$ORDER(^TMP("PSSDIN",$JOB,"OI",0))
- WRITE ?5,"No information available ",!!
- +7 IF $GET(DD)
- IF $DATA(^PSDRUG(DD,0))
- WRITE !,"Drug: "_$PIECE(^PSDRUG(DD,0),"^")_$SELECT($PIECE(^PSDRUG(DD,0),"^",9):" ***(N/F)***",1:""),!!
- Begin DoDot:1
- +8 IF $ORDER(^TMP("PSSDIN",$JOB,"DD",0))
- SET N1="DD"
- DO TXD
- +9 if '$ORDER(^TMP("PSSDIN",$JOB,"DD",0))
- WRITE ?5,"No information available ",!!
- End DoDot:1
- HLD KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- +1 QUIT
- DIN(OI,DD) ;Setup DIN indicator
- +1 SET (NFIO,NFID)=""
- +2 IF $DATA(OI)
- IF $GET(OI)
- if $PIECE($GET(^PS(50.7,OI,0)),"^",12)
- SET NFIO=" ***(N/F)***"
- +3 IF $DATA(DD)
- IF $GET(DD)
- if $PIECE($GET(^PSDRUG(DD,0)),"^",9)
- SET NFID=" ***(N/F)***"
- +4 DO EN^PSSDIN(OI,DD)
- +5 if $ORDER(^TMP("PSSDIN",$JOB,"OI",0))
- SET NFIO=NFIO_" <DIN>"
- +6 if $ORDER(^TMP("PSSDIN",$JOB,"DD",0))
- SET NFID=NFID_" <DIN>"
- +7 KILL ^TMP("PSSDIN",$JOB)
- QUIT
- +8 QUIT
- RV ;reverse video
- +1 ; Saves Normal Line formatting
- +2 IF $GET(VALMCNT)>$GET(LASTLINE)
- Begin DoDot:1
- +3 IF $DATA(VALMEVL)
- FOR L=($GET(LASTLINE)+1):1:VALMCNT
- DO SAVE^VALM10(L)
- +4 SET LASTLINE=VALMCNT
- End DoDot:1
- +5 ;
- +6 IF '$DATA(IORVON)!'$DATA(IORVOFF)
- QUIT
- +7 IF $GET(PKID)
- IF $GET(PKIE)]""
- DO CNTRL^VALM10(1,1,$LENGTH(PKIE),IORVON,IORVOFF,0)
- +8 if $GET(NFIO)
- DO CNTRL^VALM10(+NFIO,$PIECE(NFIO,",",2),5,IORVON,IORVOFF,0)
- +9 if $GET(NFID)
- DO CNTRL^VALM10(+NFID,$PIECE(NFID,",",2),5,IORVON,IORVOFF,0)
- +10 KILL NFIO,NFID,PKID
- +11 ;- Reverses video for the words "Flagged" and "Unflagged"
- +12 NEW L
- +13 FOR L=1:1:$GET(VALMCNT)
- Begin DoDot:1
- +14 if $DATA(FLAGLINE(L))
- DO CNTRL^VALM10(L,1,FLAGLINE(L),IORVON,IORVOFF,0)
- End DoDot:1
- +15 ; eRx Formatting
- +16 DO VIDEO^PSOERUT0()
- +17 QUIT
- +18 ;
- TD NEW N1,N2,N3,N4,TX,NX
- SET NX="PSSDIN"
- +1 WRITE @IOF
- +2 IF NFI="O"
- DO OIT
- +3 IF NFI="D"
- DO DDT
- +4 IF NFI="Y"
- DO DDT
- DO OIT
- +5 QUIT
- OIT ;
- +1 SET N1="OI"
- SET TX="Orderable Item Text:"
- DO TXT
- +2 QUIT
- DDT ;
- +1 SET N1="DD"
- SET TX="Dispense Drug Text:"
- DO TXT
- +2 QUIT
- TXT ;
- +1 WRITE !,TX
- TXD KILL ^UTILITY($JOB,"W")
- +1 SET N2=""
- FOR
- SET N2=$ORDER(^TMP(NX,$JOB,N1,N2))
- if 'N2!($DATA(DIRUT))
- QUIT
- Begin DoDot:1
- +2 SET N3=""
- FOR
- SET N3=$ORDER(^TMP(NX,$JOB,N1,N2,N3))
- if 'N3!($DATA(DIRUT))
- QUIT
- Begin DoDot:2
- +3 SET N4=""
- FOR
- SET N4=$ORDER(^TMP(NX,$JOB,N1,N2,N3,N4))
- if 'N4!($DATA(DIRUT))
- QUIT
- Begin DoDot:3
- +4 WRITE !?5,^TMP(NX,$JOB,N1,N2,N3,N4)
- IF $Y>20
- WRITE !
- DO HLD
- if $DATA(DIRUT)
- QUIT
- WRITE @IOF
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +5 WRITE !
- KILL ^UTILITY($JOB,"W")
- +6 QUIT