PSNHFRM ;BIR/WRT-Report of Hospital Formulary drugs from DRUG file ; 8/28/07 12:07pm
;;4.0; NATIONAL DRUG FILE;**152,160**;30 Oct 98;Build 3
DVC K IO("Q"),%ZIS,POP,IOP S %ZIS="QM",%ZIS("B")="",%ZIS("A")="DEVICE: " D ^%ZIS G:POP DONE W:$E(IOST)'="P" !!,"This report must be run on a printer.",!! G:$E(IOST)'="P" DVC I POP K IOP,POP,IO("Q") Q
QUEUE I $D(IO("Q")) K IO("Q") S ZTRTN="ENQ^PSNHFRM" K ZTSAVE,ZTDTH,ZTSK S PSNDEV=ION_";"_IOST_";"_$S($D(IO("DOC")):IO("DOC"),1:IOM)_";"_IOSL,ZTSAVE("SF")="",ZTSAVE("PSNDEV")="",ZTSAVE("PSNANS")="",ZTDESC="Hospital Formulary Report",ZTIO=""
I D ^%ZTLOAD K MJT,%ZIS,POP,IOP,ZTSK D ^%ZISC Q
ENQ ;ENTRY POINT WHEN QUEUED
D LOOP
I $D(ZTQUEUED) D QUEUE1
U IO
ENQ1 S PSNPGCT=0,PSNPGLNG=IOSL-6
D TITLE,LOOP1 W @IOF G DONE
TITLE I $D(IOF),IOF]"" W @IOF S PSNPGCT=PSNPGCT+1
W !,PSNANS
S X="T" D ^%DT X ^DD("DD") W ?55,"Date printed: ",Y,!?55,"Page: ",PSNPGCT,!!
W !,"GENERIC/TRADE NAME"
W !,?3,"GENERIC/TRADE NAME",?46,"CLASS",?59,"PRICE / DISP UNT",!
F MJT=1:1:80 W "-"
Q
DONE S:$D(ZTQUEUED) ZTREQ="@" K ^TMP($J),PSNB,PSNFLG,PSNAME,PSNCL,PSNCLSS,PSNAR,PSNFF,PSNFG,PSNGG,PSNPR,PSNLGN,PSNPGCT,PSNPGLNG,ZTRTN,Y,PSNDEV,MJT,PSNLOC,PSNKK,PSNPRIC,PSNPRICE
K PSNANS,SF,DU,PSNANSR,PSNTRD,PSNUM,PSNDATE,X,IOP,POP,IO("Q") W:$Y @IOF D ^%ZISC
Q
QUEUE1 S IOP=PSNDEV F D ^%ZIS Q:'POP H 20
Q
LOOP F PSNB=0:0 S PSNB=$O(^PSDRUG(PSNB)) Q:'PSNB D
.Q:'$D(^PSDRUG(PSNB,0))
.S PSNAME=$P(^PSDRUG(PSNB,0),"^",1) Q:PSNAME=""
.S PSNCLSS=$P(^PSDRUG(PSNB,0),"^",2) S:PSNCLSS']"" PSNCLSS="No Class" I $P(^PSDRUG(PSNB,0),"^",9)'=1 D CHECK
Q
GETDATE I '$D(^PSDRUG(PSNB,"I")) D GETNODE,GETPRIC
I $D(^PSDRUG(PSNB,"I")) S PSNDATE=$P(^PSDRUG(PSNB,"I"),"^") D NOW^%DTC I X<PSNDATE D GETNODE,GETPRIC
Q
GETNODE K X I '$D(^PSDRUG(PSNB,660)) S PSNPRICE="No Price /" D GETRADE,GETRADE1
Q
GETPRIC I $D(^PSDRUG(PSNB,660)) S PSNPRIC=$P(^PSDRUG(PSNB,660),"^",6),DU=$P(^PSDRUG(PSNB,660),"^",8) D PRICE1,PRICE2
Q
PRICE1 I PSNPRIC']"" S PSNPRICE="No Price"_" / "_DU D GETRADE,GETRADE1,BUILDIT
Q
PRICE2 I PSNPRIC]"" S PSNPRICE=PSNPRIC D PSNPR1,GETRADE,GETRADE1,BUILDIT
Q
GETRADE1 I '$O(^PSDRUG(PSNB,1,0)) K PSNAR S PSNTRD="ZZXZZXZZX" S PSNAR(1,PSNAME,PSNTRD)=""
Q
GETRADE I $O(^PSDRUG(PSNB,1,0)) K PSNAR F PSNUM=0:0 S PSNUM=$O(^PSDRUG(PSNB,1,PSNUM)) Q:'PSNUM D TRADE1,TRADE2,TRADE3
Q
TRADE1 I $P(^PSDRUG(PSNB,1,PSNUM,0),"^",3)=1 S PSNTRD="ZZXZZXZZX" S PSNAR(3,PSNAME,"ZZXZZXZZX")=""
Q
TRADE2 I $P(^PSDRUG(PSNB,1,PSNUM,0),"^",3)=0 S PSNTRD=$P(^PSDRUG(PSNB,1,PSNUM,0),"^",1) I PSNTRD]"" S PSNAR(1,PSNAME,PSNTRD)=""
Q
TRADE3 I $P(^PSDRUG(PSNB,1,PSNUM,0),"^",3)="" S PSNTRD="ZZXZZXZZX" S PSNAR(2,PSNAME,"ZZXZZXZZX")=""
Q
BUILDIT F PSNKK=1,2,3 D BUILDIT1
Q
BUILDIT1 S PSNFF="" F S PSNFF=$O(PSNAR(PSNKK,PSNFF)) Q:PSNFF="" S PSNGG="" F S PSNGG=$O(PSNAR(PSNKK,PSNFF,PSNGG)) Q:PSNGG="" D BUILD
Q
BUILD S PSNFG=0 I PSNFG=0 S:'$D(^TMP($J,"PSNF",PSNFF)) ^TMP($J,"PSNF",PSNFF,PSNGG,PSNCLSS,PSNPRICE)="" S:PSNGG'="ZZXZZXZZX" ^TMP($J,"PSNF",PSNGG,PSNFF,PSNCLSS,PSNPRICE)=""
Q
LOOP1 S PSNLGN="" F S PSNLGN=$O(^TMP($J,"PSNF",PSNLGN)) Q:PSNLGN="" S PSNFLG=1 D LOOP2
Q
LOOP2 S PSNLOC="" F S PSNLOC=$O(^TMP($J,"PSNF",PSNLGN,PSNLOC)) Q:PSNLOC="" D LOOP3
Q
LOOP3 S PSNCL="" F S PSNCL=$O(^TMP($J,"PSNF",PSNLGN,PSNLOC,PSNCL)) Q:PSNCL="" D LOOP4
Q
LOOP4 S PSNPR="" F S PSNPR=$O(^TMP($J,"PSNF",PSNLGN,PSNLOC,PSNCL,PSNPR)) Q:PSNPR="" D WRITE
Q
WRITE D:$Y>PSNPGLNG TITLE W:PSNFLG !,PSNLGN,! S PSNFLG=0 W ?3 W:PSNLOC'="ZZXZZXZZX" PSNLOC W:PSNLOC="ZZXZZXZZX" " " W ?46,PSNCL,?59,PSNPR,!
Q
DATE K ^TMP($J,"PSNDT") F PSNB=0:0 S PSNB=$O(^PSDRUG(PSNB)) Q:'PSNB D DATE0
Q
DATE0 I '$D(^PSDRUG(PSNB,"I")) S ^TMP($J,"PSNDT",PSNB)=""
I $D(^PSDRUG(PSNB,"I")) S PSNDATE=$P(^PSDRUG(PSNB,"I"),"^") D NOW^%DTC I X<PSNDATE S ^TMP($J,"PSNDT",PSNB)="" K PSNDATE,X
Q
PSNPR1 S PSNPRICE=$J(PSNPRIC,3,3),PSNPRICE=PSNPRICE_" / "_DU
Q
CHECK I SF=0,$P(^PSDRUG(PSNB,0),"^",3)'["S" D GETDATE
I SF=1 D GETDATE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNHFRM 3975 printed Jun 11, 2024@22:04:45 Page 2
PSNHFRM ;BIR/WRT-Report of Hospital Formulary drugs from DRUG file ; 8/28/07 12:07pm
+1 ;;4.0; NATIONAL DRUG FILE;**152,160**;30 Oct 98;Build 3
DVC KILL IO("Q"),%ZIS,POP,IOP
SET %ZIS="QM"
SET %ZIS("B")=""
SET %ZIS("A")="DEVICE: "
DO ^%ZIS
if POP
GOTO DONE
if $EXTRACT(IOST)'="P"
WRITE !!,"This report must be run on a printer.",!!
if $EXTRACT(IOST)'="P"
GOTO DVC
IF POP
KILL IOP,POP,IO("Q")
QUIT
QUEUE IF $DATA(IO("Q"))
KILL IO("Q")
SET ZTRTN="ENQ^PSNHFRM"
KILL ZTSAVE,ZTDTH,ZTSK
SET PSNDEV=ION_";"_IOST_";"_$SELECT($DATA(IO("DOC")):IO("DOC"),1:IOM)_";"_IOSL
SET ZTSAVE("SF")=""
SET ZTSAVE("PSNDEV")=""
SET ZTSAVE("PSNANS")=""
SET ZTDESC="Hospital Formulary Report"
SET ZTIO=""
+1 IF $TEST
DO ^%ZTLOAD
KILL MJT,%ZIS,POP,IOP,ZTSK
DO ^%ZISC
QUIT
ENQ ;ENTRY POINT WHEN QUEUED
+1 DO LOOP
+2 IF $DATA(ZTQUEUED)
DO QUEUE1
+3 USE IO
ENQ1 SET PSNPGCT=0
SET PSNPGLNG=IOSL-6
+1 DO TITLE
DO LOOP1
WRITE @IOF
GOTO DONE
TITLE IF $DATA(IOF)
IF IOF]""
WRITE @IOF
SET PSNPGCT=PSNPGCT+1
+1 WRITE !,PSNANS
+2 SET X="T"
DO ^%DT
XECUTE ^DD("DD")
WRITE ?55,"Date printed: ",Y,!?55,"Page: ",PSNPGCT,!!
+3 WRITE !,"GENERIC/TRADE NAME"
+4 WRITE !,?3,"GENERIC/TRADE NAME",?46,"CLASS",?59,"PRICE / DISP UNT",!
+5 FOR MJT=1:1:80
WRITE "-"
+6 QUIT
DONE if $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL ^TMP($JOB),PSNB,PSNFLG,PSNAME,PSNCL,PSNCLSS,PSNAR,PSNFF,PSNFG,PSNGG,PSNPR,PSNLGN,PSNPGCT,PSNPGLNG,ZTRTN,Y,PSNDEV,MJT,PSNLOC,PSNKK,PSNPRIC,PSNPRICE
+1 KILL PSNANS,SF,DU,PSNANSR,PSNTRD,PSNUM,PSNDATE,X,IOP,POP,IO("Q")
if $Y
WRITE @IOF
DO ^%ZISC
+2 QUIT
QUEUE1 SET IOP=PSNDEV
FOR
DO ^%ZIS
if 'POP
QUIT
HANG 20
+1 QUIT
LOOP FOR PSNB=0:0
SET PSNB=$ORDER(^PSDRUG(PSNB))
if 'PSNB
QUIT
Begin DoDot:1
+1 if '$DATA(^PSDRUG(PSNB,0))
QUIT
+2 SET PSNAME=$PIECE(^PSDRUG(PSNB,0),"^",1)
if PSNAME=""
QUIT
+3 SET PSNCLSS=$PIECE(^PSDRUG(PSNB,0),"^",2)
if PSNCLSS']""
SET PSNCLSS="No Class"
IF $PIECE(^PSDRUG(PSNB,0),"^",9)'=1
DO CHECK
End DoDot:1
+4 QUIT
GETDATE IF '$DATA(^PSDRUG(PSNB,"I"))
DO GETNODE
DO GETPRIC
+1 IF $DATA(^PSDRUG(PSNB,"I"))
SET PSNDATE=$PIECE(^PSDRUG(PSNB,"I"),"^")
DO NOW^%DTC
IF X<PSNDATE
DO GETNODE
DO GETPRIC
+2 QUIT
GETNODE KILL X
IF '$DATA(^PSDRUG(PSNB,660))
SET PSNPRICE="No Price /"
DO GETRADE
DO GETRADE1
+1 QUIT
GETPRIC IF $DATA(^PSDRUG(PSNB,660))
SET PSNPRIC=$PIECE(^PSDRUG(PSNB,660),"^",6)
SET DU=$PIECE(^PSDRUG(PSNB,660),"^",8)
DO PRICE1
DO PRICE2
+1 QUIT
PRICE1 IF PSNPRIC']""
SET PSNPRICE="No Price"_" / "_DU
DO GETRADE
DO GETRADE1
DO BUILDIT
+1 QUIT
PRICE2 IF PSNPRIC]""
SET PSNPRICE=PSNPRIC
DO PSNPR1
DO GETRADE
DO GETRADE1
DO BUILDIT
+1 QUIT
GETRADE1 IF '$ORDER(^PSDRUG(PSNB,1,0))
KILL PSNAR
SET PSNTRD="ZZXZZXZZX"
SET PSNAR(1,PSNAME,PSNTRD)=""
+1 QUIT
GETRADE IF $ORDER(^PSDRUG(PSNB,1,0))
KILL PSNAR
FOR PSNUM=0:0
SET PSNUM=$ORDER(^PSDRUG(PSNB,1,PSNUM))
if 'PSNUM
QUIT
DO TRADE1
DO TRADE2
DO TRADE3
+1 QUIT
TRADE1 IF $PIECE(^PSDRUG(PSNB,1,PSNUM,0),"^",3)=1
SET PSNTRD="ZZXZZXZZX"
SET PSNAR(3,PSNAME,"ZZXZZXZZX")=""
+1 QUIT
TRADE2 IF $PIECE(^PSDRUG(PSNB,1,PSNUM,0),"^",3)=0
SET PSNTRD=$PIECE(^PSDRUG(PSNB,1,PSNUM,0),"^",1)
IF PSNTRD]""
SET PSNAR(1,PSNAME,PSNTRD)=""
+1 QUIT
TRADE3 IF $PIECE(^PSDRUG(PSNB,1,PSNUM,0),"^",3)=""
SET PSNTRD="ZZXZZXZZX"
SET PSNAR(2,PSNAME,"ZZXZZXZZX")=""
+1 QUIT
BUILDIT FOR PSNKK=1,2,3
DO BUILDIT1
+1 QUIT
BUILDIT1 SET PSNFF=""
FOR
SET PSNFF=$ORDER(PSNAR(PSNKK,PSNFF))
if PSNFF=""
QUIT
SET PSNGG=""
FOR
SET PSNGG=$ORDER(PSNAR(PSNKK,PSNFF,PSNGG))
if PSNGG=""
QUIT
DO BUILD
+1 QUIT
BUILD SET PSNFG=0
IF PSNFG=0
if '$DATA(^TMP($JOB,"PSNF",PSNFF))
SET ^TMP($JOB,"PSNF",PSNFF,PSNGG,PSNCLSS,PSNPRICE)=""
if PSNGG'="ZZXZZXZZX"
SET ^TMP($JOB,"PSNF",PSNGG,PSNFF,PSNCLSS,PSNPRICE)=""
+1 QUIT
LOOP1 SET PSNLGN=""
FOR
SET PSNLGN=$ORDER(^TMP($JOB,"PSNF",PSNLGN))
if PSNLGN=""
QUIT
SET PSNFLG=1
DO LOOP2
+1 QUIT
LOOP2 SET PSNLOC=""
FOR
SET PSNLOC=$ORDER(^TMP($JOB,"PSNF",PSNLGN,PSNLOC))
if PSNLOC=""
QUIT
DO LOOP3
+1 QUIT
LOOP3 SET PSNCL=""
FOR
SET PSNCL=$ORDER(^TMP($JOB,"PSNF",PSNLGN,PSNLOC,PSNCL))
if PSNCL=""
QUIT
DO LOOP4
+1 QUIT
LOOP4 SET PSNPR=""
FOR
SET PSNPR=$ORDER(^TMP($JOB,"PSNF",PSNLGN,PSNLOC,PSNCL,PSNPR))
if PSNPR=""
QUIT
DO WRITE
+1 QUIT
WRITE if $Y>PSNPGLNG
DO TITLE
if PSNFLG
WRITE !,PSNLGN,!
SET PSNFLG=0
WRITE ?3
if PSNLOC'="ZZXZZXZZX"
WRITE PSNLOC
if PSNLOC="ZZXZZXZZX"
WRITE " "
WRITE ?46,PSNCL,?59,PSNPR,!
+1 QUIT
DATE KILL ^TMP($JOB,"PSNDT")
FOR PSNB=0:0
SET PSNB=$ORDER(^PSDRUG(PSNB))
if 'PSNB
QUIT
DO DATE0
+1 QUIT
DATE0 IF '$DATA(^PSDRUG(PSNB,"I"))
SET ^TMP($JOB,"PSNDT",PSNB)=""
+1 IF $DATA(^PSDRUG(PSNB,"I"))
SET PSNDATE=$PIECE(^PSDRUG(PSNB,"I"),"^")
DO NOW^%DTC
IF X<PSNDATE
SET ^TMP($JOB,"PSNDT",PSNB)=""
KILL PSNDATE,X
+2 QUIT
PSNPR1 SET PSNPRICE=$JUSTIFY(PSNPRIC,3,3)
SET PSNPRICE=PSNPRICE_" / "_DU
+1 QUIT
CHECK IF SF=0
IF $PIECE(^PSDRUG(PSNB,0),"^",3)'["S"
DO GETDATE
+1 IF SF=1
DO GETDATE
+2 QUIT
