PSNSUPLY.m

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 ---PSNSUPLY   2077     printed  Apr 09, 2024@21:19:01                                                                                                                                                                                                    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