PSJMON ;BIR/MV - Display/Print Monograph ;6 Jun 07 / 3:37 PM
;;5.0; INPATIENT MEDICATIONS ;**181**;16 DEC 97;Build 190
;
MON(PSJMON) ;Process monographs
NEW PSJPRTFL,PSJIOF,PSJSERVR
S PSJPRTFL=0,PSJIOF=1
Q:'$$ASK()
D LSTMON(.PSJMON)
D:PSJPRTFL DSPMON
K PSJMON,^TMP($J,"PSJPMON")
Q
;
ASK(X) ;Ask if user want to see the monograph
NEW PSJX,DIR,DTOUT,DUOUT,DIRUT,Y
S PSJX=$S($G(X):"(s)",1:"")
K DIR S DIR(0)="Y",DIR("A")="Display Professional Interaction Monograph(s)"_PSJX,DIR("B")="NO" D ^DIR
I 'Y K PSJMON W !
Q Y
DSPMON ;
NEW ZTDESC,ZTRTN,ZTSAVE
K IOP,%ZIS,POP S %ZIS="QM" D ^%ZIS
I POP K SEL,DIR,DTOUT,DUOUT,DIRUT,MONT W !,"NOTHING PRINTED" Q
I $D(IO("Q")) D Q
.S ZTRTN="OUT^PSJMON",ZTDESC="Monograph Report of Drug Interactions"
.S ZTSAVE("LIST")="",ZTSAVE("^TMP($J,""PSJPMON"",")=""
.D ^%ZTLOAD,^%ZISC W !,"Monograph Queued to Print!",! S:$D(ZTQUEUED) ZTREQ="Q"
D OUT,^%ZISC
Q
OUT ;Print the Professional Monograph
NEW PSJMONV,PSJPN,PSJQUIT,PSJNUM
U IO
S PSJQUIT=0
F PSJNUM=0:0 S PSJNUM=$O(^TMP($J,"PSJPMON",PSJNUM)) Q:'PSJNUM D
.S PSJSERVR="" F S PSJSERVR=$O(^TMP($J,"PSJPMON",PSJNUM,PSJSERVR)) Q:PSJSERVR="" F PSJPN=0:0 S PSJPN=$O(^TMP($J,"PSJPMON",PSJNUM,PSJSERVR,PSJPN)) Q:'PSJPN Q:PSJQUIT=2 D
.. S PSJMONV=^TMP($J,"PSJPMON",PSJNUM,PSJSERVR,PSJPN)
.. I PSJMONV="Professional Monograph " S PSJQUIT=0 D
... I $G(PSJIOF) K PSJIOF W !! W @IOF Q
... ;Ignore 1 "^" and display the next mon.
... I '$G(PSJIOF) W !! S:$E(IOST)="C" PSJQUIT=$$PAUSE1^PSJMISC() S:PSJQUIT=1 PSJQUIT=0 W @IOF
.. I PSJQUIT Q
.. W !,PSJMONV
.. I $Y+4>IOSL,$E(IOST)="C" W ! S PSJQUIT=$$PAUSE1^PSJMISC() W @IOF S:PSJQUIT=1 PSJIOF=1
W !
Q
LSTMON(PSJMON) ;Display a list of monographs to the user & store mon for printing to screen/printer
;PSJMON(ProfileVaGEN+ProspectiveDrugname,monographTitle)=P1...P11 (PSJMON array groups the same drug pair and title into one selectable choice)
;PSJMONS(seq no,monographTitle)=P1...P11 (a drug pair may have 1 or more titles. This array is to store title 2 and subsequence)
;PSJMONLI(n)=P1...P11 (PSJMONLI array keeps the drug pair/monograph in a numeric list)
;P1 : Sequential #
;P2 : Drug name (profile)
;P3 : Profile Drug IEN file 50
;P4 : Drug name of order being worked on
;p5 : Drug IEN file 50 from order being worked on
;P6 : Pharmacy order # (Package;ON;PROFILE/PROSPECTIVE;SEQ # (I;29V;PROFILE;1)
;P7 : Severity (C: critical, S: significant)
;P8 : Use by PSJMONLI array (extra PMON for the same pair)
;P9 : If set to 1, the display will be "CRITICAL/SIGNIFICANT" for severity in the selection drug pair display
;P10: If set to 1, the package display will be "IO" in the selection drug pair display
;P11: VA GENERIC name (profile)
NEW DIR,DIRUT,DTOUT,DUOUT,PSJCNT,PSJPON1,PSJMONV,PSJMONTI,PSJDNM,PSJN,PSJPN,PSJS,PSJSEV1,PSJX,PSJX1,PSJY,X,Y
NEW PSJMONLI,PSJMONS
K ^TMP($J,"PSJPMON")
D NUMLST
S PSJY=$O(PSJMONLI(""),-1)
I PSJY>1 S PSJY=$$SELLST(.PSJMONLI)
Q:'+PSJY
S PSJPRTFL=1
S PSJCNT=0
F PSJX1=1:1:$L(PSJY) S PSJX=$P(PSJY,",",PSJX1) Q:PSJX="" D
. S PSJMONV=PSJMONLI(PSJX)
. D SETMON(PSJX1,PSJMONV)
. I +$P(PSJMONV,U,8) S PSJMONTI="" F S PSJMONTI=$O(PSJMONS(PSJX,PSJMONTI)) Q:PSJMONTI="" D
.. S PSJMONV=PSJMONS(PSJX,PSJMONTI) D SETMON(PSJX1,PSJMONV)
Q
SELLST(PSJMONLI) ;Only present selection pair if there are more than 1 pair in the list
NEW DIR,DIRUT,DTOUT,DUOUT,PSJPON1,PSJMONV,PSJS,PSJSEV1,PSJX,X,Y
W !
F PSJX=0:0 S PSJX=$O(PSJMONLI(PSJX)) Q:'PSJX D
. S PSJMONV=PSJMONLI(PSJX)
. F X=1:1:11 S PSJS(X)=$P(PSJMONV,U,X)
. S PSJSEV1=$S(PSJS(9):"CRITICAL/SIGNIFICANT",PSJS(7)="C":"CRITICAL",PSJS(7)="S":"SIGNIFICANT",1:"")
. S PSJPON1=$S(PSJS(10):"IO",$P(PSJS(6),";")="I":"I",1:"O")
. W !,PSJX,". ",$$VAGEN^PSJMISC(PSJS(5))," and ",$P(PSJS(11),"+")," ("_PSJSEV1_" - "_PSJPON1_")"
W !
K DIR S DIR(0)="LO^1:"_$O(PSJMONLI(""),-1),DIR("A")="Select Monograph(s) for printing by number" D ^DIR
Q Y
SETMON(PSJNUM,PSJMONV) ;Setup monograph for screen/prt
;PSJNUM - selected # from monograph's list
NEW PSJPN,PSJS,X
I $G(PSJMONV)="" Q
Q:'$G(PSJNUM)
F X=1:1:11 S PSJS(X)=$P(PSJMONV,U,X)
S X=$G(^TMP($J,"PSJPRE","OUT","DRUGDRUG",PSJS(7),PSJS(2),PSJS(6),PSJS(1),"PMON",5,0))
S X=$P(X,"SEVERITY LEVEL: ",2)
S PSJSERVR=PSJS(11)_$E(X,1,1)
D STOREMON("Professional Monograph",PSJSERVR)
S PSJMONV="Drug Interaction with "_$P(PSJS(11),"+")_" and "_$$VAGEN^PSJMISC(PSJS(5))
D STOREMON(PSJMONV,PSJSERVR),STOREMON("",PSJSERVR)
F PSJPN=0:0 S PSJPN=$O(^TMP($J,"PSJPRE","OUT","DRUGDRUG",PSJS(7),PSJS(2),PSJS(6),PSJS(1),"PMON",PSJPN)) Q:'PSJPN D
. S PSJMONV=$G(^TMP($J,"PSJPRE","OUT","DRUGDRUG",PSJS(7),PSJS(2),PSJS(6),PSJS(1),"PMON",PSJPN,0))
. S PSJCNT=PSJCNT+1
. D STOREMON(PSJMONV,PSJSERVR)
Q
NUMLST ;Set the monograph into a number selectable list
NEW PSJDNM,PSJMONTI,PSJMFLG,PSJN,PSJON1,PSJON2,PSJONFG
S PSJN=0
S PSJDNM="" F S PSJDNM=$O(PSJMON(PSJDNM)) Q:PSJDNM="" S PSJMONTI="",PSJMFLG=0 F S PSJMONTI=$O(PSJMON(PSJDNM,PSJMONTI)) Q:PSJMONTI="" D
. I 'PSJMFLG S PSJN=PSJN+1 S PSJMONLI(PSJN)=PSJMON(PSJDNM,PSJMONTI)
. I PSJMFLG D
.. S PSJMONLI(PSJN)=PSJMONLI(PSJN)_"^^"_PSJN
.. S $P(PSJMONLI(PSJN),U,8)=1
.. S PSJMONS(PSJN,PSJMONTI)=PSJMON(PSJDNM,PSJMONTI)
.. S PSJON1=$P($P(PSJMONLI(PSJN),U,6),";")
.. S PSJON2=$P($P(PSJMONS(PSJN,PSJMONTI),U,6),";")
.. S PSJONFG=0
.. I PSJON1="I",PSJON1'="I" S PSJONFG=1
.. I PSJON1'="I",PSJON1="I" S PSJONFG=1
.. S:PSJONFG $P(PSJMONLI(PSJN),U,10)=1
.. I $P(PSJMONLI(PSJN),U,7)'=$P(PSJMONS(PSJN,PSJMONTI),U,7) S $P(PSJMONLI(PSJN),U,9)=1
. S PSJMFLG=1
K PSJON1,PSJON2,PSJONFG
Q
STOREMON(PSJX,PSJSERVR) ;Store the formatted Monograph
NEW PSJX1,X,Y,Y1
Q:'$G(PSJNUM)
I $G(PSJSERVR)="" S PSJSERVR=1
S PSJCNT=$G(PSJCNT)+1
S X="REFERENCES:"
I $E(PSJX,1,$L(X))=X S ^TMP($J,"PSJPMON",PSJNUM,PSJSERVR,PSJCNT)=X,PSJCNT=PSJCNT+1 S PSJX=$P(PSJX,X,2)
S PSJX1=""
F Y=1:1:$L(PSJX," ") S Y1=$P(PSJX," ",Y) D
. I ($L(PSJX1)+$L(Y1)+1)>73 S:$E(PSJX1,1,1)=" " PSJX1=$E(PSJX1,2,$L(PSJX1)) S ^TMP($J,"PSJPMON",PSJNUM,PSJSERVR,PSJCNT)=PSJX1,PSJX1="",PSJCNT=PSJCNT+1
. S PSJX1=PSJX1_Y1_" "
I PSJX1]"" S ^TMP($J,"PSJPMON",PSJNUM,PSJSERVR,PSJCNT)=PSJX1
K PSJX1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSJMON 6249 printed Sep 23, 2025@19:43:51 Page 2
PSJMON ;BIR/MV - Display/Print Monograph ;6 Jun 07 / 3:37 PM
+1 ;;5.0; INPATIENT MEDICATIONS ;**181**;16 DEC 97;Build 190
+2 ;
MON(PSJMON) ;Process monographs
+1 NEW PSJPRTFL,PSJIOF,PSJSERVR
+2 SET PSJPRTFL=0
SET PSJIOF=1
+3 if '$$ASK()
QUIT
+4 DO LSTMON(.PSJMON)
+5 if PSJPRTFL
DO DSPMON
+6 KILL PSJMON,^TMP($JOB,"PSJPMON")
+7 QUIT
+8 ;
ASK(X) ;Ask if user want to see the monograph
+1 NEW PSJX,DIR,DTOUT,DUOUT,DIRUT,Y
+2 SET PSJX=$SELECT($GET(X):"(s)",1:"")
+3 KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Display Professional Interaction Monograph(s)"_PSJX
SET DIR("B")="NO"
DO ^DIR
+4 IF 'Y
KILL PSJMON
WRITE !
+5 QUIT Y
DSPMON ;
+1 NEW ZTDESC,ZTRTN,ZTSAVE
+2 KILL IOP,%ZIS,POP
SET %ZIS="QM"
DO ^%ZIS
+3 IF POP
KILL SEL,DIR,DTOUT,DUOUT,DIRUT,MONT
WRITE !,"NOTHING PRINTED"
QUIT
+4 IF $DATA(IO("Q"))
Begin DoDot:1
+5 SET ZTRTN="OUT^PSJMON"
SET ZTDESC="Monograph Report of Drug Interactions"
+6 SET ZTSAVE("LIST")=""
SET ZTSAVE("^TMP($J,""PSJPMON"",")=""
+7 DO ^%ZTLOAD
DO ^%ZISC
WRITE !,"Monograph Queued to Print!",!
if $DATA(ZTQUEUED)
SET ZTREQ="Q"
End DoDot:1
QUIT
+8 DO OUT
DO ^%ZISC
+9 QUIT
OUT ;Print the Professional Monograph
+1 NEW PSJMONV,PSJPN,PSJQUIT,PSJNUM
+2 USE IO
+3 SET PSJQUIT=0
+4 FOR PSJNUM=0:0
SET PSJNUM=$ORDER(^TMP($JOB,"PSJPMON",PSJNUM))
if 'PSJNUM
QUIT
Begin DoDot:1
+5 SET PSJSERVR=""
FOR
SET PSJSERVR=$ORDER(^TMP($JOB,"PSJPMON",PSJNUM,PSJSERVR))
if PSJSERVR=""
QUIT
FOR PSJPN=0:0
SET PSJPN=$ORDER(^TMP($JOB,"PSJPMON",PSJNUM,PSJSERVR,PSJPN))
if 'PSJPN
QUIT
if PSJQUIT=2
QUIT
Begin DoDot:2
+6 SET PSJMONV=^TMP($JOB,"PSJPMON",PSJNUM,PSJSERVR,PSJPN)
+7 IF PSJMONV="Professional Monograph "
SET PSJQUIT=0
Begin DoDot:3
+8 IF $GET(PSJIOF)
KILL PSJIOF
WRITE !!
WRITE @IOF
QUIT
+9 ;Ignore 1 "^" and display the next mon.
+10 IF '$GET(PSJIOF)
WRITE !!
if $EXTRACT(IOST)="C"
SET PSJQUIT=$$PAUSE1^PSJMISC()
if PSJQUIT=1
SET PSJQUIT=0
WRITE @IOF
End DoDot:3
+11 IF PSJQUIT
QUIT
+12 WRITE !,PSJMONV
+13 IF $Y+4>IOSL
IF $EXTRACT(IOST)="C"
WRITE !
SET PSJQUIT=$$PAUSE1^PSJMISC()
WRITE @IOF
if PSJQUIT=1
SET PSJIOF=1
End DoDot:2
End DoDot:1
+14 WRITE !
+15 QUIT
LSTMON(PSJMON) ;Display a list of monographs to the user & store mon for printing to screen/printer
+1 ;PSJMON(ProfileVaGEN+ProspectiveDrugname,monographTitle)=P1...P11 (PSJMON array groups the same drug pair and title into one selectable choice)
+2 ;PSJMONS(seq no,monographTitle)=P1...P11 (a drug pair may have 1 or more titles. This array is to store title 2 and subsequence)
+3 ;PSJMONLI(n)=P1...P11 (PSJMONLI array keeps the drug pair/monograph in a numeric list)
+4 ;P1 : Sequential #
+5 ;P2 : Drug name (profile)
+6 ;P3 : Profile Drug IEN file 50
+7 ;P4 : Drug name of order being worked on
+8 ;p5 : Drug IEN file 50 from order being worked on
+9 ;P6 : Pharmacy order # (Package;ON;PROFILE/PROSPECTIVE;SEQ # (I;29V;PROFILE;1)
+10 ;P7 : Severity (C: critical, S: significant)
+11 ;P8 : Use by PSJMONLI array (extra PMON for the same pair)
+12 ;P9 : If set to 1, the display will be "CRITICAL/SIGNIFICANT" for severity in the selection drug pair display
+13 ;P10: If set to 1, the package display will be "IO" in the selection drug pair display
+14 ;P11: VA GENERIC name (profile)
+15 NEW DIR,DIRUT,DTOUT,DUOUT,PSJCNT,PSJPON1,PSJMONV,PSJMONTI,PSJDNM,PSJN,PSJPN,PSJS,PSJSEV1,PSJX,PSJX1,PSJY,X,Y
+16 NEW PSJMONLI,PSJMONS
+17 KILL ^TMP($JOB,"PSJPMON")
+18 DO NUMLST
+19 SET PSJY=$ORDER(PSJMONLI(""),-1)
+20 IF PSJY>1
SET PSJY=$$SELLST(.PSJMONLI)
+21 if '+PSJY
QUIT
+22 SET PSJPRTFL=1
+23 SET PSJCNT=0
+24 FOR PSJX1=1:1:$LENGTH(PSJY)
SET PSJX=$PIECE(PSJY,",",PSJX1)
if PSJX=""
QUIT
Begin DoDot:1
+25 SET PSJMONV=PSJMONLI(PSJX)
+26 DO SETMON(PSJX1,PSJMONV)
+27 IF +$PIECE(PSJMONV,U,8)
SET PSJMONTI=""
FOR
SET PSJMONTI=$ORDER(PSJMONS(PSJX,PSJMONTI))
if PSJMONTI=""
QUIT
Begin DoDot:2
+28 SET PSJMONV=PSJMONS(PSJX,PSJMONTI)
DO SETMON(PSJX1,PSJMONV)
End DoDot:2
End DoDot:1
+29 QUIT
SELLST(PSJMONLI) ;Only present selection pair if there are more than 1 pair in the list
+1 NEW DIR,DIRUT,DTOUT,DUOUT,PSJPON1,PSJMONV,PSJS,PSJSEV1,PSJX,X,Y
+2 WRITE !
+3 FOR PSJX=0:0
SET PSJX=$ORDER(PSJMONLI(PSJX))
if 'PSJX
QUIT
Begin DoDot:1
+4 SET PSJMONV=PSJMONLI(PSJX)
+5 FOR X=1:1:11
SET PSJS(X)=$PIECE(PSJMONV,U,X)
+6 SET PSJSEV1=$SELECT(PSJS(9):"CRITICAL/SIGNIFICANT",PSJS(7)="C":"CRITICAL",PSJS(7)="S":"SIGNIFICANT",1:"")
+7 SET PSJPON1=$SELECT(PSJS(10):"IO",$PIECE(PSJS(6),";")="I":"I",1:"O")
+8 WRITE !,PSJX,". ",$$VAGEN^PSJMISC(PSJS(5))," and ",$PIECE(PSJS(11),"+")," ("_PSJSEV1_" - "_PSJPON1_")"
End DoDot:1
+9 WRITE !
+10 KILL DIR
SET DIR(0)="LO^1:"_$ORDER(PSJMONLI(""),-1)
SET DIR("A")="Select Monograph(s) for printing by number"
DO ^DIR
+11 QUIT Y
SETMON(PSJNUM,PSJMONV) ;Setup monograph for screen/prt
+1 ;PSJNUM - selected # from monograph's list
+2 NEW PSJPN,PSJS,X
+3 IF $GET(PSJMONV)=""
QUIT
+4 if '$GET(PSJNUM)
QUIT
+5 FOR X=1:1:11
SET PSJS(X)=$PIECE(PSJMONV,U,X)
+6 SET X=$GET(^TMP($JOB,"PSJPRE","OUT","DRUGDRUG",PSJS(7),PSJS(2),PSJS(6),PSJS(1),"PMON",5,0))
+7 SET X=$PIECE(X,"SEVERITY LEVEL: ",2)
+8 SET PSJSERVR=PSJS(11)_$EXTRACT(X,1,1)
+9 DO STOREMON("Professional Monograph",PSJSERVR)
+10 SET PSJMONV="Drug Interaction with "_$PIECE(PSJS(11),"+")_" and "_$$VAGEN^PSJMISC(PSJS(5))
+11 DO STOREMON(PSJMONV,PSJSERVR)
DO STOREMON("",PSJSERVR)
+12 FOR PSJPN=0:0
SET PSJPN=$ORDER(^TMP($JOB,"PSJPRE","OUT","DRUGDRUG",PSJS(7),PSJS(2),PSJS(6),PSJS(1),"PMON",PSJPN))
if 'PSJPN
QUIT
Begin DoDot:1
+13 SET PSJMONV=$GET(^TMP($JOB,"PSJPRE","OUT","DRUGDRUG",PSJS(7),PSJS(2),PSJS(6),PSJS(1),"PMON",PSJPN,0))
+14 SET PSJCNT=PSJCNT+1
+15 DO STOREMON(PSJMONV,PSJSERVR)
End DoDot:1
+16 QUIT
NUMLST ;Set the monograph into a number selectable list
+1 NEW PSJDNM,PSJMONTI,PSJMFLG,PSJN,PSJON1,PSJON2,PSJONFG
+2 SET PSJN=0
+3 SET PSJDNM=""
FOR
SET PSJDNM=$ORDER(PSJMON(PSJDNM))
if PSJDNM=""
QUIT
SET PSJMONTI=""
SET PSJMFLG=0
FOR
SET PSJMONTI=$ORDER(PSJMON(PSJDNM,PSJMONTI))
if PSJMONTI=""
QUIT
Begin DoDot:1
+4 IF 'PSJMFLG
SET PSJN=PSJN+1
SET PSJMONLI(PSJN)=PSJMON(PSJDNM,PSJMONTI)
+5 IF PSJMFLG
Begin DoDot:2
+6 SET PSJMONLI(PSJN)=PSJMONLI(PSJN)_"^^"_PSJN
+7 SET $PIECE(PSJMONLI(PSJN),U,8)=1
+8 SET PSJMONS(PSJN,PSJMONTI)=PSJMON(PSJDNM,PSJMONTI)
+9 SET PSJON1=$PIECE($PIECE(PSJMONLI(PSJN),U,6),";")
+10 SET PSJON2=$PIECE($PIECE(PSJMONS(PSJN,PSJMONTI),U,6),";")
+11 SET PSJONFG=0
+12 IF PSJON1="I"
IF PSJON1'="I"
SET PSJONFG=1
+13 IF PSJON1'="I"
IF PSJON1="I"
SET PSJONFG=1
+14 if PSJONFG
SET $PIECE(PSJMONLI(PSJN),U,10)=1
+15 IF $PIECE(PSJMONLI(PSJN),U,7)'=$PIECE(PSJMONS(PSJN,PSJMONTI),U,7)
SET $PIECE(PSJMONLI(PSJN),U,9)=1
End DoDot:2
+16 SET PSJMFLG=1
End DoDot:1
+17 KILL PSJON1,PSJON2,PSJONFG
+18 QUIT
STOREMON(PSJX,PSJSERVR) ;Store the formatted Monograph
+1 NEW PSJX1,X,Y,Y1
+2 if '$GET(PSJNUM)
QUIT
+3 IF $GET(PSJSERVR)=""
SET PSJSERVR=1
+4 SET PSJCNT=$GET(PSJCNT)+1
+5 SET X="REFERENCES:"
+6 IF $EXTRACT(PSJX,1,$LENGTH(X))=X
SET ^TMP($JOB,"PSJPMON",PSJNUM,PSJSERVR,PSJCNT)=X
SET PSJCNT=PSJCNT+1
SET PSJX=$PIECE(PSJX,X,2)
+7 SET PSJX1=""
+8 FOR Y=1:1:$LENGTH(PSJX," ")
SET Y1=$PIECE(PSJX," ",Y)
Begin DoDot:1
+9 IF ($LENGTH(PSJX1)+$LENGTH(Y1)+1)>73
if $EXTRACT(PSJX1,1,1)=" "
SET PSJX1=$EXTRACT(PSJX1,2,$LENGTH(PSJX1))
SET ^TMP($JOB,"PSJPMON",PSJNUM,PSJSERVR,PSJCNT)=PSJX1
SET PSJX1=""
SET PSJCNT=PSJCNT+1
+10 SET PSJX1=PSJX1_Y1_" "
End DoDot:1
+11 IF PSJX1]""
SET ^TMP($JOB,"PSJPMON",PSJNUM,PSJSERVR,PSJCNT)=PSJX1
+12 KILL PSJX1
+13 QUIT
