1 | PSNSUPLY ;BIR/WRT-Print report of drugs with an "XA" classification- SORT BY CLASS CODE ;01/12/98 5:18 PM
|
---|
2 | ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
|
---|
3 | 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 "
|
---|
4 | W "to re-class your local items",!,"with an ""XA"" classification using the newly expanded ""XA000"" classification. It"
|
---|
5 | 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.",!
|
---|
6 | 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
|
---|
7 | 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
|
---|
8 | ENQ ;ENTRY POINT WHEN QUEUED
|
---|
9 | U IO
|
---|
10 | S PSNPGCT=0,PSNPGLNG=IOSL-6,PSNPRT=0 D TITLE,LOOP1
|
---|
11 | DONE I $D(PSNPRT) W:PSNPRT=0 !!?10,"No Entries Found"
|
---|
12 | W @IOF S:$D(ZTQUEUED) ZTREQ="@" K PSNPRT,PSNB,CODE,NAME,CLSDA,WRT,MJT,PSNPGCT,PSNPGLNG,Y,IOP,POP,IO("Q") D ^%ZISC
|
---|
13 | Q
|
---|
14 | TITLE I $D(IOF),IOF]"" W @IOF S PSNPGCT=PSNPGCT+1
|
---|
15 | W !,?8,"LOCAL ITEMS WITH A ""PROSTHETICS/SUPPLIES/DEVICES"" VA CLASSIFICATION",!
|
---|
16 | S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?55,"Page: ",PSNPGCT,!
|
---|
17 | W !,"NUMBER",?10,"LOCAL DRUG GENERIC NAME",?57,"VA CLASS",?70,"NEW CLASS",!
|
---|
18 | F MJT=1:1:80 W "-"
|
---|
19 | Q
|
---|
20 | LOOP1 S NAME="" F WRT=0:0 S NAME=$O(^PSDRUG("B",NAME)) Q:NAME="" S PSNB=$O(^PSDRUG("B",NAME,0)) D LOOP2
|
---|
21 | Q
|
---|
22 | 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
|
---|
23 | Q
|
---|
24 | STRIP S CODE=$P(^PS(50.605,CLSDA,0),"^",1) I "XA"[$E(CODE,1,2) D REPRT
|
---|
25 | Q
|
---|
26 | 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
|
---|
27 | Q
|
---|