PSNOCLS.m

PSNOCLS ;BIR/CCH&WRT-Print report of drugs with no classification ;01/12/98   5:18 PM

 ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98

 W !!,"This report should be run after executing the menu option ""Merge National Drug",!,"File Data Into Local File"". It may be useful to print this report before and",!,"after executing the ""Allow Unmatched Drugs To Be Classed"" option."

 W " It gives you",!,"a hard copy of the drugs from your local drug file which are ""active"" and have",!

 W "no 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^PSNOCLS",ZTDESC="Local Drugs With No 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,LOOP

DONE I $D(PSNPRT) W:PSNPRT=0 !!?23,"No Drugs Found"

 W @IOF S:$D(ZTQUEUED) ZTREQ="@" K PSNB,BT,PSNPRT,PSNDEA,ZX,PSNMRK,MJT,PSNPGCT,PSNPGLNG,PSNOLD,Y,IOP,POP,IO("Q") D ^%ZISC

 Q

TITLE I $D(IOF),IOF]"" W @IOF S PSNPGCT=PSNPGCT+1

 W !,?23,"LOCAL DRUGS WITH NO VA CLASSIFICATION",!

 S Y=DT X ^DD("DD") W !,"Date printed: ",Y,?55,"Page: ",PSNPGCT,!

 W !,"NUMBER",?10,"LOCAL DRUG GENERIC NAME",?67,"DEA",!

 F MJT=1:1:80 W "-"

 Q

LOOP F PSNB=0:0 S PSNB=$O(^PSDRUG(PSNB)) Q:'PSNB  I '$D(^PSDRUG(PSNB,"ND")),'$D(^PSDRUG(PSNB,"I")) D REPRT I PSNMRK=1 D WRTDEA

 Q

REPRT D:$Y>PSNPGLNG TITLE W !!,PSNB,?10,$P(^PSDRUG(PSNB,0),"^",1) S PSNPRT=1,PSNDEA=$P(^PSDRUG(PSNB,0),"^",3),PSNMRK=0 F ZX=1:1:$L(PSNDEA) S BT=$E(PSNDEA,ZX) I "0IM"[BT S PSNMRK=1

 Q

WRTDEA W ?67,$P(^PSDRUG(PSNB,0),"^",3)

 Q

PSNOCLS   ;BIR/CCH&WRT-Print report of drugs with no classification ;01/12/98   5:18 PM

 +1       ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98

 +2        WRITE !!,"This report should be run after executing the menu option ""Merge National Drug",!,"File Data Into Local File"". It may be useful to print this report before and",!,"after executing the ""Allow Unmatched Drugs To Be Classed"" option."

 +3        WRITE " It gives you",!,"a hard copy of the drugs from your local drug file which are ""active"" and have",!

 +4        WRITE "no 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^PSNOCLS"

               SET ZTDESC="Local Drugs With No 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 LOOP

DONE       IF $DATA(PSNPRT)

               IF PSNPRT=0

                   WRITE !!?23,"No Drugs Found"

 +1        WRITE @IOF

           IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

           KILL PSNB,BT,PSNPRT,PSNDEA,ZX,PSNMRK,MJT,PSNPGCT,PSNPGLNG,PSNOLD,Y,IOP,POP,IO("Q")

           DO ^%ZISC

 +2        QUIT 

TITLE      IF $DATA(IOF)

               IF IOF]""

                   WRITE @IOF

                   SET PSNPGCT=PSNPGCT+1

 +1        WRITE !,?23,"LOCAL DRUGS WITH NO VA CLASSIFICATION",!

 +2        SET Y=DT

           XECUTE ^DD("DD")

           WRITE !,"Date printed: ",Y,?55,"Page: ",PSNPGCT,!

 +3        WRITE !,"NUMBER",?10,"LOCAL DRUG GENERIC NAME",?67,"DEA",!

 +4        FOR MJT=1:1:80

               WRITE "-"

 +5        QUIT 

LOOP       FOR PSNB=0:0

               SET PSNB=$ORDER(^PSDRUG(PSNB))

               IF 'PSNB

                   QUIT 

               IF '$DATA(^PSDRUG(PSNB,"ND"))

                   IF '$DATA(^PSDRUG(PSNB,"I"))

                       DO REPRT

                       IF PSNMRK=1

                           DO WRTDEA

 +1        QUIT 

REPRT      IF $Y>PSNPGLNG

               DO TITLE

           WRITE !!,PSNB,?10,$PIECE(^PSDRUG(PSNB,0),"^",1)

           SET PSNPRT=1

           SET PSNDEA=$PIECE(^PSDRUG(PSNB,0),"^",3)

           SET PSNMRK=0

           FOR ZX=1:1:$LENGTH(PSNDEA)

               SET BT=$EXTRACT(PSNDEA,ZX)

               IF "0IM"[BT

                   SET PSNMRK=1

 +1        QUIT 

WRTDEA     WRITE ?67,$PIECE(^PSDRUG(PSNB,0),"^",3)

 +1        QUIT