| [613] | 1 | PSNHFRM1 ;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
 | 
|---|
 | 3 | ENQ1 S PSNPGCT=0,PSNPGLNG=IOSL-6
 | 
|---|
 | 4 |  D TITLE,LOOP1 W @IOF G DONE
 | 
|---|
 | 5 | TITLE 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
 | 
|---|
 | 12 | 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
 | 
|---|
 | 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
 | 
|---|
 | 15 | QUEUE1 S IOP=PSNDEV F  D ^%ZIS Q:'POP  H 20
 | 
|---|
 | 16 |  Q
 | 
|---|
 | 17 | 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
 | 
|---|
 | 18 |  Q
 | 
|---|
 | 19 | GETDATE 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
 | 
|---|
 | 22 | GETNODE K X I '$D(^PSDRUG(PSNB,660)) S PSNPRICE="No Price /" D GETRADE,GETRADE1
 | 
|---|
 | 23 |  Q
 | 
|---|
 | 24 | GETPRIC I $D(^PSDRUG(PSNB,660)) S PSNPRIC=$P(^PSDRUG(PSNB,660),"^",6),DU=$P(^PSDRUG(PSNB,660),"^",8) D PRICE1,PRICE2
 | 
|---|
 | 25 |  Q
 | 
|---|
 | 26 | PRICE1 I PSNPRIC']"" S PSNPRICE="No Price"_" / "_DU D GETRADE,GETRADE1,BUILDIT
 | 
|---|
 | 27 |  Q
 | 
|---|
 | 28 | PRICE2 I PSNPRIC]"" S PSNPRICE=PSNPRIC,PSNPRICE=PSNPRICE_" / "_DU D GETRADE,GETRADE1,BUILDIT
 | 
|---|
 | 29 |  Q
 | 
|---|
 | 30 | GETRADE1 I '$O(^PSDRUG(PSNB,1,0)) K PSNAR S PSNTRD="ZZXZZXZZX" S PSNAR(1,PSNCLSS,PSNAME,PSNTRD)=""
 | 
|---|
 | 31 |  Q
 | 
|---|
 | 32 | 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
 | 
|---|
 | 33 |  Q
 | 
|---|
 | 34 | TRADE1 I $P(^PSDRUG(PSNB,1,PSNUM,0),"^",3)=1 S PSNTRD="ZZXZZXZZX" S PSNAR(3,PSNCLSS,PSNAME,PSNTRD)=""
 | 
|---|
 | 35 |  Q
 | 
|---|
 | 36 | 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)=""
 | 
|---|
 | 37 |  Q
 | 
|---|
 | 38 | TRADE3 I $P(^PSDRUG(PSNB,1,PSNUM,0),"^",3)="" S PSNTRD="ZZXZZXZZX" S PSNAR(2,PSNCLSS,PSNAME,PSNTRD)=""
 | 
|---|
 | 39 |  Q
 | 
|---|
 | 40 | BUILDIT F PSNKK=1,2,3 D BUILDIT1
 | 
|---|
 | 41 |  Q
 | 
|---|
 | 42 | 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
 | 
|---|
 | 43 |  Q
 | 
|---|
 | 44 | BUILD S PSNFG=0 I PSNFG=0 S ^TMP($J,"PSNFC",PSNFF,PSNGG,PSNPRICE,PSNHH)=PSNVCN
 | 
|---|
 | 45 |  Q
 | 
|---|
 | 46 | LOOP1 S PSNCL="" F  S PSNCL=$O(^TMP($J,"PSNFC",PSNCL)) Q:PSNCL=""  S PSNFLG=1 D LOOP2
 | 
|---|
 | 47 |  Q
 | 
|---|
 | 48 | LOOP2 S PSNLGN="" F  S PSNLGN=$O(^TMP($J,"PSNFC",PSNCL,PSNLGN)) Q:PSNLGN=""  S PSNFLAGG=1 D LOOP3
 | 
|---|
 | 49 |  Q
 | 
|---|
 | 50 | LOOP3 S PSNPR="" F  S PSNPR=$O(^TMP($J,"PSNFC",PSNCL,PSNLGN,PSNPR)) Q:PSNPR=""  S PSNFG1=1 D LOOP4
 | 
|---|
 | 51 |  Q
 | 
|---|
 | 52 | 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
 | 
|---|
 | 53 |  Q
 | 
|---|
 | 54 | 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
 | 
|---|
 | 55 |  W !
 | 
|---|
 | 56 |  Q
 | 
|---|
 | 57 | CHECK I SF=0,$P(^PSDRUG(PSNB,0),"^",3)'["S" D GETDATE
 | 
|---|
 | 58 |  I SF=1 D GETDATE
 | 
|---|
 | 59 |  Q
 | 
|---|