Changeset 623 for WorldVistAEHR/trunk/r/NATIONAL_DRUG_FILE-PSN/PSNHFRM.m

Timestamp:

Dec 4, 2009, 12:11:15 AM (14 years ago)

Author:

George Lilly

Message:

revised back to 6/30/08 version

File:

• WorldVistAEHR/trunk/r/NATIONAL_DRUG_FILE-PSN/PSNHFRM.m (modified) (1 diff)

WorldVistAEHR/trunk/r/NATIONAL_DRUG_FILE-PSN/PSNHFRM.m

@@ -1 @@
-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 ; 10/18/98 17:48
+ ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
+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_";"_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  S PSNAME=$P(^PSDRUG(PSNB,0),"^",1),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) 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