60 lines
3.1 KiB
Mathematica
60 lines
3.1 KiB
Mathematica
PSNHFRM1 ;BIR/WRT-Report of Hospital Formulary drugs from DRUG file -sort by class ; 11/22/98 15:10
|
|
;;4.0; NATIONAL DRUG FILE;**3**; 30 Oct 98
|
|
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_" FORMULARY (BY VA DRUG CLASS)"
|
|
S X="T",%DT="" D ^%DT X ^DD("DD") W ?55,"Date printed: ",Y,!?55,"Page: ",PSNPGCT,!!
|
|
W !,?10,"VA DRUG CLASS",!,?29,"PRICE /"
|
|
W !,"GENERIC NAME",?29,"DISP UNT",?49,"TRADE NAME(S)",!
|
|
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,PSNCN,PSNFG1,PSNFG2,PSNFLAGG,PSNHH,PSNQ,PSNVCN,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 S PSNB=D0,PSNAME=$P(^PSDRUG(PSNB,0),"^",1),PSNCLSS=$P(^PSDRUG(PSNB,0),"^",2),PSNQ=$O(^PS(50.605,"B",PSNCLSS,0)),PSNVCN=$P(^PS(50.605,PSNQ,0),"^",2) 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,PSNPRICE=PSNPRICE_" / "_DU D GETRADE,GETRADE1,BUILDIT
|
|
Q
|
|
GETRADE1 I '$O(^PSDRUG(PSNB,1,0)) K PSNAR S PSNTRD="ZZXZZXZZX" S PSNAR(1,PSNCLSS,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,PSNCLSS,PSNAME,PSNTRD)=""
|
|
Q
|
|
TRADE2 I $P(^PSDRUG(PSNB,1,PSNUM,0),"^",3)=0 S PSNTRD=$P(^PSDRUG(PSNB,1,PSNUM,0),"^",1) S PSNAR(1,PSNCLSS,PSNAME,PSNTRD)=""
|
|
Q
|
|
TRADE3 I $P(^PSDRUG(PSNB,1,PSNUM,0),"^",3)="" S PSNTRD="ZZXZZXZZX" S PSNAR(2,PSNCLSS,PSNAME,PSNTRD)=""
|
|
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="" S PSNHH="" F S PSNHH=$O(PSNAR(PSNKK,PSNFF,PSNGG,PSNHH)) Q:PSNHH="" D BUILD
|
|
Q
|
|
BUILD S PSNFG=0 I PSNFG=0 S ^TMP($J,"PSNFC",PSNFF,PSNGG,PSNPRICE,PSNHH)=PSNVCN
|
|
Q
|
|
LOOP1 S PSNCL="" F S PSNCL=$O(^TMP($J,"PSNFC",PSNCL)) Q:PSNCL="" S PSNFLG=1 D LOOP2
|
|
Q
|
|
LOOP2 S PSNLGN="" F S PSNLGN=$O(^TMP($J,"PSNFC",PSNCL,PSNLGN)) Q:PSNLGN="" S PSNFLAGG=1 D LOOP3
|
|
Q
|
|
LOOP3 S PSNPR="" F S PSNPR=$O(^TMP($J,"PSNFC",PSNCL,PSNLGN,PSNPR)) Q:PSNPR="" S PSNFG1=1 D LOOP4
|
|
Q
|
|
LOOP4 S PSNLOC="" F S PSNLOC=$O(^TMP($J,"PSNFC",PSNCL,PSNLGN,PSNPR,PSNLOC)) Q:PSNLOC="" S PSNFG2=1,PSNCN=$P(^TMP($J,"PSNFC",PSNCL,PSNLGN,PSNPR,PSNLOC),"^") D WRITE
|
|
Q
|
|
WRITE D:$Y>PSNPGLNG TITLE W:PSNFLG !!?10,PSNCL_" "_PSNCN,! S PSNFLG=0 W:PSNFLAGG !,PSNLGN S PSNFLAGG=0 W:PSNFG1 !?29,PSNPR S PSNFG1=0 I PSNLOC'="ZZXZZXZZX" W:PSNFG2 ?49,PSNLOC S PSNFG2=0
|
|
W !
|
|
Q
|
|
CHECK I SF=0,$P(^PSDRUG(PSNB,0),"^",3)'["S" D GETDATE
|
|
I SF=1 D GETDATE
|
|
Q
|