- PSNMCLS ;BIR/WRT-Print report of drugs manually classed (excluding supply items) SORT BY LOCAL GENERIC NAME ;01/12/98 5:18 PM
- ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
- W !!,"This report will give you an alphabetic listing, by local generic name, of the",!,"drugs from your local drug file which are ""active"" and have been assigned a",!
- W "manual VA Drug Classification through the option ""Allow Unmatched Drugs To Be",!,"Classed"". This report will exclude your supply items that have been assigned",!,"an ""XA"" class."
- W !,"You may queue the report to print, if you wish.",!
- DVC K %ZIS,POP,IOP S %ZIS="QM",%ZIS("B")="",%ZIS("A")="Select Printer: " 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^PSNMCLS",ZTDESC="Manually Classed Drugs Report" D ^%ZTLOAD K ZTSK D ^%ZISC Q
- ENQ ;ENTRY POINT WHEN QUEUED
- U IO
- S PSNPGCT=0,PSNPGLNG=IOSL-6,PSNPRT=0 D TITLE,LOOP1
- DONE I $D(PSNPRT) W:PSNPRT=0 !!?23,"No Drugs Found"
- W @IOF S:$D(ZTQUEUED) ZTREQ="@" K PSNPRT,PSNB,NAME,CLSDA,WRT,CODE,MJT,PSNPGCT,PSNPGLNG,Y,IOP,POP,IO("Q") D ^%ZISC
- Q
- TITLE I $D(IOF),IOF]"" W @IOF S PSNPGCT=PSNPGCT+1
- W !,?23,"MANUALLY CLASSED DRUGS REPORT",!
- S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?55,"Page: ",PSNPGCT,!
- W !,"NUMBER",?10,"LOCAL DRUG GENERIC NAME",?63,"VA DRUG CLASS",!
- F MJT=1:1:80 W "-"
- Q
- LOOP1 S NAME="" F WRT=0:0 S NAME=$O(^PSDRUG("B",NAME)) Q:NAME="" F PSNB=0:0 S PSNB=$O(^PSDRUG("B",NAME,PSNB)) Q:'PSNB D LOOP2
- Q
- LOOP2 I '$D(^PSDRUG(PSNB,"I")),$D(^PSDRUG(PSNB,"ND")),$P(^PSDRUG(PSNB,"ND"),"^",2)']"" S CLSDA=$P(^PSDRUG(PSNB,"ND"),"^",6) I $D(^PS(50.605,CLSDA,0)) D STRIP
- Q
- STRIP S CODE=$P(^PS(50.605,CLSDA,0),"^",1) I "XA"'[$E(CODE,1,2) D REPRT
- Q
- REPRT D:$Y>PSNPGLNG TITLE W !!,PSNB,?10,$P(^PSDRUG(PSNB,0),"^",1),?63,$P(^PS(50.605,$P(^PSDRUG(PSNB,"ND"),"^",6),0),"^",1) S PSNPRT=1
- Q
- PSNMCLS ;BIR/WRT-Print report of drugs manually classed (excluding supply items) SORT BY LOCAL GENERIC NAME ;01/12/98 5:18 PM
- +1 ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
- +2 WRITE !!,"This report will give you an alphabetic listing, by local generic name, of the",!,"drugs from your local drug file which are ""active"" and have been assigned a",!
- +3 WRITE "manual VA Drug Classification through the option ""Allow Unmatched Drugs To Be",!,"Classed"". This report will exclude your supply items that have been assigned",!,"an ""XA"" class."
- +4 WRITE !,"You may queue the report to print, if you wish.",!
- DVC KILL %ZIS,POP,IOP
- SET %ZIS="QM"
- SET %ZIS("B")=""
- SET %ZIS("A")="Select Printer: "
- DO ^%ZIS
- IF POP
- GOTO DONE
- IF $EXTRACT(IOST)'="P"
- WRITE !!,"This report must be run on a printer.",!!
- IF $EXTRACT(IOST)'="P"
- GOTO DVC
- IF POP
- KILL IOP,POP,IO("Q")
- QUIT
- QUEUE IF $DATA(IO("Q"))
- KILL IO("Q")
- SET ZTRTN="ENQ^PSNMCLS"
- SET ZTDESC="Manually Classed Drugs Report"
- DO ^%ZTLOAD
- KILL ZTSK
- DO ^%ZISC
- QUIT
- ENQ ;ENTRY POINT WHEN QUEUED
- +1 USE IO
- +2 SET PSNPGCT=0
- SET PSNPGLNG=IOSL-6
- SET PSNPRT=0
- DO TITLE
- DO LOOP1
- DONE IF $DATA(PSNPRT)
- IF PSNPRT=0
- WRITE !!?23,"No Drugs Found"
- +1 WRITE @IOF
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- KILL PSNPRT,PSNB,NAME,CLSDA,WRT,CODE,MJT,PSNPGCT,PSNPGLNG,Y,IOP,POP,IO("Q")
- DO ^%ZISC
- +2 QUIT
- TITLE IF $DATA(IOF)
- IF IOF]""
- WRITE @IOF
- SET PSNPGCT=PSNPGCT+1
- +1 WRITE !,?23,"MANUALLY CLASSED DRUGS REPORT",!
- +2 SET Y=DT
- XECUTE ^DD("DD")
- WRITE !,"Date printed: ",Y,?55,"Page: ",PSNPGCT,!
- +3 WRITE !,"NUMBER",?10,"LOCAL DRUG GENERIC NAME",?63,"VA DRUG CLASS",!
- +4 FOR MJT=1:1:80
- WRITE "-"
- +5 QUIT
- LOOP1 SET NAME=""
- FOR WRT=0:0
- SET NAME=$ORDER(^PSDRUG("B",NAME))
- IF NAME=""
- QUIT
- FOR PSNB=0:0
- SET PSNB=$ORDER(^PSDRUG("B",NAME,PSNB))
- IF 'PSNB
- QUIT
- DO LOOP2
- +1 QUIT
- LOOP2 IF '$DATA(^PSDRUG(PSNB,"I"))
- IF $DATA(^PSDRUG(PSNB,"ND"))
- IF $PIECE(^PSDRUG(PSNB,"ND"),"^",2)']""
- SET CLSDA=$PIECE(^PSDRUG(PSNB,"ND"),"^",6)
- IF $DATA(^PS(50.605,CLSDA,0))
- DO STRIP
- +1 QUIT
- STRIP SET CODE=$PIECE(^PS(50.605,CLSDA,0),"^",1)
- IF "XA"'[$EXTRACT(CODE,1,2)
- DO REPRT
- +1 QUIT
- REPRT IF $Y>PSNPGLNG
- DO TITLE
- WRITE !!,PSNB,?10,$PIECE(^PSDRUG(PSNB,0),"^",1),?63,$PIECE(^PS(50.605,$PIECE(^PSDRUG(PSNB,"ND"),"^",6),0),"^",1)
- SET PSNPRT=1
- +1 QUIT
