PSONFI ;BIR/MHA - dispense drug/orderable item text display ;09/13/00
;;7.0;OUTPATIENT PHARMACY;**46,94,131,225,391,700**;DEC 1997;Build 261
;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
. F L=($G(LASTLINE)+1):1:VALMCNT D SAVE^VALM10(L)
. S LASTLINE=VALMCNT
;
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 3007 printed Apr 09, 2024@21:37:56 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**;DEC 1997;Build 261
+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 FOR L=($GET(LASTLINE)+1):1:VALMCNT
DO SAVE^VALM10(L)
+4 SET LASTLINE=VALMCNT
End DoDot:1
+5 ;
+6 IF $GET(PKID)
IF $GET(PKIE)]""
DO CNTRL^VALM10(1,1,$LENGTH(PKIE),IORVON,IORVOFF,0)
+7 if $GET(NFIO)
DO CNTRL^VALM10(+NFIO,$PIECE(NFIO,",",2),5,IORVON,IORVOFF,0)
+8 if $GET(NFID)
DO CNTRL^VALM10(+NFID,$PIECE(NFID,",",2),5,IORVON,IORVOFF,0)
+9 KILL NFIO,NFID,PKID
+10 ;- Reverses video for the words "Flagged" and "Unflagged"
+11 NEW L
+12 FOR L=1:1:$GET(VALMCNT)
Begin DoDot:1
+13 if $DATA(FLAGLINE(L))
DO CNTRL^VALM10(L,1,FLAGLINE(L),IORVON,IORVOFF,0)
End DoDot:1
+14 ; eRx Formatting
+15 DO VIDEO^PSOERUT0()
+16 QUIT
+17 ;
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
