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