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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNMCLS 1938 printed Oct 16, 2024@18:24:58 Page 2
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
