- 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
- 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
