source: WorldVistAEHR/trunk/r/NATIONAL_DRUG_FILE-PSN/PSNHFRM1.m@ 771

Last change on this file since 771 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1PSNHFRM1 ;BIR/WRT-Report of Hospital Formulary drugs from DRUG file -sort by class ; 11/22/98 15:10
2 ;;4.0; NATIONAL DRUG FILE;**3**; 30 Oct 98
3ENQ1 S PSNPGCT=0,PSNPGLNG=IOSL-6
4 D TITLE,LOOP1 W @IOF G DONE
5TITLE I $D(IOF),IOF]"" W @IOF S PSNPGCT=PSNPGCT+1
6 W !,PSNANS_" FORMULARY (BY VA DRUG CLASS)"
7 S X="T",%DT="" D ^%DT X ^DD("DD") W ?55,"Date printed: ",Y,!?55,"Page: ",PSNPGCT,!!
8 W !,?10,"VA DRUG CLASS",!,?29,"PRICE /"
9 W !,"GENERIC NAME",?29,"DISP UNT",?49,"TRADE NAME(S)",!
10 F MJT=1:1:80 W "-"
11 Q
12DONE 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
13 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
14 Q
15QUEUE1 S IOP=PSNDEV F D ^%ZIS Q:'POP H 20
16 Q
17LOOP 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
18 Q
19GETDATE I '$D(^PSDRUG(PSNB,"I")) D GETNODE,GETPRIC
20 I $D(^PSDRUG(PSNB,"I")) S PSNDATE=$P(^PSDRUG(PSNB,"I"),"^") D NOW^%DTC I X<PSNDATE D GETNODE,GETPRIC
21 Q
22GETNODE K X I '$D(^PSDRUG(PSNB,660)) S PSNPRICE="No Price /" D GETRADE,GETRADE1
23 Q
24GETPRIC I $D(^PSDRUG(PSNB,660)) S PSNPRIC=$P(^PSDRUG(PSNB,660),"^",6),DU=$P(^PSDRUG(PSNB,660),"^",8) D PRICE1,PRICE2
25 Q
26PRICE1 I PSNPRIC']"" S PSNPRICE="No Price"_" / "_DU D GETRADE,GETRADE1,BUILDIT
27 Q
28PRICE2 I PSNPRIC]"" S PSNPRICE=PSNPRIC,PSNPRICE=PSNPRICE_" / "_DU D GETRADE,GETRADE1,BUILDIT
29 Q
30GETRADE1 I '$O(^PSDRUG(PSNB,1,0)) K PSNAR S PSNTRD="ZZXZZXZZX" S PSNAR(1,PSNCLSS,PSNAME,PSNTRD)=""
31 Q
32GETRADE 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
33 Q
34TRADE1 I $P(^PSDRUG(PSNB,1,PSNUM,0),"^",3)=1 S PSNTRD="ZZXZZXZZX" S PSNAR(3,PSNCLSS,PSNAME,PSNTRD)=""
35 Q
36TRADE2 I $P(^PSDRUG(PSNB,1,PSNUM,0),"^",3)=0 S PSNTRD=$P(^PSDRUG(PSNB,1,PSNUM,0),"^",1) S PSNAR(1,PSNCLSS,PSNAME,PSNTRD)=""
37 Q
38TRADE3 I $P(^PSDRUG(PSNB,1,PSNUM,0),"^",3)="" S PSNTRD="ZZXZZXZZX" S PSNAR(2,PSNCLSS,PSNAME,PSNTRD)=""
39 Q
40BUILDIT F PSNKK=1,2,3 D BUILDIT1
41 Q
42BUILDIT1 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
43 Q
44BUILD S PSNFG=0 I PSNFG=0 S ^TMP($J,"PSNFC",PSNFF,PSNGG,PSNPRICE,PSNHH)=PSNVCN
45 Q
46LOOP1 S PSNCL="" F S PSNCL=$O(^TMP($J,"PSNFC",PSNCL)) Q:PSNCL="" S PSNFLG=1 D LOOP2
47 Q
48LOOP2 S PSNLGN="" F S PSNLGN=$O(^TMP($J,"PSNFC",PSNCL,PSNLGN)) Q:PSNLGN="" S PSNFLAGG=1 D LOOP3
49 Q
50LOOP3 S PSNPR="" F S PSNPR=$O(^TMP($J,"PSNFC",PSNCL,PSNLGN,PSNPR)) Q:PSNPR="" S PSNFG1=1 D LOOP4
51 Q
52LOOP4 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
53 Q
54WRITE 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
55 W !
56 Q
57CHECK I SF=0,$P(^PSDRUG(PSNB,0),"^",3)'["S" D GETDATE
58 I SF=1 D GETDATE
59 Q
Note: See TracBrowser for help on using the repository browser.