- PSNSUPLY ;BIR/WRT-Print report of drugs with an "XA" classification- SORT BY CLASS CODE ;01/12/98 5:18 PM
- ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
- W !!,"This report should be run if you have already classed your local drugs/items",!,"using Version 1.0 of NDF. After the installation of Version 2.0 of NDF and the",!,"VA DRUG CLASS file is re-installed, you may wish "
- W "to re-class your local items",!,"with an ""XA"" classification using the newly expanded ""XA000"" classification. It"
- W !,"gives you a hard copy of the items from your local drug file which are ""active"" and have an ""XA"" VA Drug Classification.",!,"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^PSNSUPLY",ZTDESC="Supply (XA000) VA Class 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 !!?10,"No Entries Found"
- W @IOF S:$D(ZTQUEUED) ZTREQ="@" K PSNPRT,PSNB,CODE,NAME,CLSDA,WRT,MJT,PSNPGCT,PSNPGLNG,Y,IOP,POP,IO("Q") D ^%ZISC
- Q
- TITLE I $D(IOF),IOF]"" W @IOF S PSNPGCT=PSNPGCT+1
- W !,?8,"LOCAL ITEMS WITH A ""PROSTHETICS/SUPPLIES/DEVICES"" VA CLASSIFICATION",!
- S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?55,"Page: ",PSNPGCT,!
- W !,"NUMBER",?10,"LOCAL DRUG GENERIC NAME",?57,"VA CLASS",?70,"NEW CLASS",!
- F MJT=1:1:80 W "-"
- Q
- LOOP1 S NAME="" F WRT=0:0 S NAME=$O(^PSDRUG("B",NAME)) Q:NAME="" S PSNB=$O(^PSDRUG("B",NAME,0)) 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),?57,$P(^PS(50.605,$P(^PSDRUG(PSNB,"ND"),"^",6),0),"^",1),?70,"_______" S PSNPRT=1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNSUPLY 2077 printed Feb 18, 2025@23:51:20 Page 2
- PSNSUPLY ;BIR/WRT-Print report of drugs with an "XA" classification- SORT BY CLASS CODE ;01/12/98 5:18 PM
- +1 ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
- +2 WRITE !!,"This report should be run if you have already classed your local drugs/items",!,"using Version 1.0 of NDF. After the installation of Version 2.0 of NDF and the",!,"VA DRUG CLASS file is re-installed, you may wish "
- +3 WRITE "to re-class your local items",!,"with an ""XA"" classification using the newly expanded ""XA000"" classification. It"
- +4 WRITE !,"gives you a hard copy of the items from your local drug file which are ""active"" and have an ""XA"" VA Drug Classification.",!,"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^PSNSUPLY"
- SET ZTDESC="Supply (XA000) VA Class 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 !!?10,"No Entries Found"
- +1 WRITE @IOF
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- KILL PSNPRT,PSNB,CODE,NAME,CLSDA,WRT,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 !,?8,"LOCAL ITEMS WITH A ""PROSTHETICS/SUPPLIES/DEVICES"" VA CLASSIFICATION",!
- +2 SET Y=DT
- XECUTE ^DD("DD")
- WRITE !,"Date printed: ",Y,?55,"Page: ",PSNPGCT,!
- +3 WRITE !,"NUMBER",?10,"LOCAL DRUG GENERIC NAME",?57,"VA CLASS",?70,"NEW 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
- SET PSNB=$ORDER(^PSDRUG("B",NAME,0))
- 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),?57,$PIECE(^PS(50.605,$PIECE(^PSDRUG(PSNB,"ND"),"^",6),0),"^",1),?70,"_______"
- SET PSNPRT=1
- +1 QUIT