PSNONDF.m

PSNONDF ;BIR/WRT-Print report of drugs with no match to NDF (all or only OP) ; 11/22/98 15:11

 ;;4.0; NATIONAL DRUG FILE;**3,5**; 30 Oct 98

 ;

 ; Reference to ^PSDRUG supported by IA# 221

 ;

 W !!,"This report should be run after executing the menu option ""Merge National Drug",!,"File Data Into Local File""."

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

 W " no match to NDF. You have the choice",!,"to print ALL drugs or only drugs marked for Outpatient use. If you answer ""yes"" to the question, you will print all. If you answer ""no"", you will print only",!,"Outpatient use drugs."

 W !,"You may queue the report to print, if you wish.",!

ASK S PSNOP=0,PSNFLAG=0 W !!,"Do you wish to print ALL drugs from your local file? " K DIR S DIR(0)="Y" D ^DIR D OUT I PSNFLAG=1 K PSNOP,PSNFLAG,X Q

 I "Nn"[X S PSNOP=1

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^PSNONDF",ZTDESC="Local Drugs With No Match To NDF Report",ZTSAVE("PSNOP")="" 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,PSNFLAG,PSNLCL,PSNMC,PSNOP,PSNUSE,PSNVCL,PSNPRT,MJT,PSNPGCT,PSNPGLNG,Y,DEA,DIR,INDT,X,IOP,POP,IO("Q") D ^%ZISC

 Q

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

 W !,?23,"LOCAL DRUGS WITH NO MATCH TO NDF",!

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

 W !?54,"DEA,",!?46,"MANUAL",?54,"SPCL",?61,"INACTIVE"

 W !,"LOCAL DRUG GENERIC NAME",?46,"CLASS",?54,"HDLG",?61,"DATE",!

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

 Q

LOOP S PSNLCL="" F  S PSNLCL=$O(^PSDRUG("B",PSNLCL)) Q:PSNLCL=""  F PSNB=0:0 S PSNB=$O(^PSDRUG("B",PSNLCL,PSNB)) Q:'PSNB  D CHECK

 Q

CHECK I PSNOP=0 D NOTHG,MCLS

 I PSNOP=1 D OUTPAT

 Q

OUTPAT S PSNUSE=$G(^PSDRUG(PSNB,2)) I $P(PSNUSE,"^",3)["O" D NOTHG,MCLS

 Q

NOTHG I '$D(^PSDRUG(PSNB,"ND")) S PSNVCL="",DEA=$P(^PSDRUG(PSNB,0),"^",3),INDT=$G(^PSDRUG(PSNB,"I")) D REPRT

 Q

MCLS I $D(^PSDRUG(PSNB,"ND")) S PSNMC=^PSDRUG(PSNB,"ND") I $P(PSNMC,"^",2)']"" S PSNVCL=$P(^PSDRUG(PSNB,0),"^",2),DEA=$P(^PSDRUG(PSNB,0),"^",3),INDT=$G(^PSDRUG(PSNB,"I")) D REPRT

 Q

REPRT D:$Y>PSNPGLNG TITLE W !!,PSNLCL,?46,PSNVCL,?54,DEA I INDT]"" S Y=INDT D DD^%DT W ?61,Y

 S PSNPRT=1

 Q

OUT I $D(DTOUT),DTOUT=1 S PSNFLAG=1

 I X="^" S PSNFLAG=1

 Q

PSNONDF   ;BIR/WRT-Print report of drugs with no match to NDF (all or only OP) ; 11/22/98 15:11

 +1       ;;4.0; NATIONAL DRUG FILE;**3,5**; 30 Oct 98

 +2       ;

 +3       ; Reference to ^PSDRUG supported by IA# 221

 +4       ;

 +5        WRITE !!,"This report should be run after executing the menu option ""Merge National Drug",!,"File Data Into Local File""."

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

 +7        WRITE " no match to NDF. You have the choice",!,"to print ALL drugs or only drugs marked for Outpatient use. If you answer ""yes"" to the question, you will print all. If you answer ""no"", you will print only",!,"Outpatient use drugs."

 +8        WRITE !,"You may queue the report to print, if you wish.",!

ASK        SET PSNOP=0

           SET PSNFLAG=0

           WRITE !!,"Do you wish to print ALL drugs from your local file? "

           KILL DIR

           SET DIR(0)="Y"

           DO ^DIR

           DO OUT

           IF PSNFLAG=1

               KILL PSNOP,PSNFLAG,X

               QUIT 

 +1        IF "Nn"[X

               SET PSNOP=1

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^PSNONDF"

               SET ZTDESC="Local Drugs With No Match To NDF Report"

               SET ZTSAVE("PSNOP")=""

               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,PSNFLAG,PSNLCL,PSNMC,PSNOP,PSNUSE,PSNVCL,PSNPRT,MJT,PSNPGCT,PSNPGLNG,Y,DEA,DIR,INDT,X,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 MATCH TO NDF",!

 +2        SET Y=DT

           XECUTE ^DD("DD")

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

 +3        WRITE !?54,"DEA,",!?46,"MANUAL",?54,"SPCL",?61,"INACTIVE"

 +4        WRITE !,"LOCAL DRUG GENERIC NAME",?46,"CLASS",?54,"HDLG",?61,"DATE",!

 +5        FOR MJT=1:1:80

               WRITE "-"

 +6        QUIT 

LOOP       SET PSNLCL=""

           FOR 

               SET PSNLCL=$ORDER(^PSDRUG("B",PSNLCL))

               IF PSNLCL=""

                   QUIT 

               FOR PSNB=0:0

                   SET PSNB=$ORDER(^PSDRUG("B",PSNLCL,PSNB))

                   IF 'PSNB

                       QUIT 

                   DO CHECK

 +1        QUIT 

CHECK      IF PSNOP=0

               DO NOTHG

               DO MCLS

 +1        IF PSNOP=1

               DO OUTPAT

 +2        QUIT 

OUTPAT     SET PSNUSE=$GET(^PSDRUG(PSNB,2))

           IF $PIECE(PSNUSE,"^",3)["O"

               DO NOTHG

               DO MCLS

 +1        QUIT 

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

               SET PSNVCL=""

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

               SET INDT=$GET(^PSDRUG(PSNB,"I"))

               DO REPRT

 +1        QUIT 

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

               SET PSNMC=^PSDRUG(PSNB,"ND")

               IF $PIECE(PSNMC,"^",2)']""

                   SET PSNVCL=$PIECE(^PSDRUG(PSNB,0),"^",2)

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

                   SET INDT=$GET(^PSDRUG(PSNB,"I"))

                   DO REPRT

 +1        QUIT 

REPRT      IF $Y>PSNPGLNG

               DO TITLE

           WRITE !!,PSNLCL,?46,PSNVCL,?54,DEA

           IF INDT]""

               SET Y=INDT

               DO DD^%DT

               WRITE ?61,Y

 +1        SET PSNPRT=1

 +2        QUIT 

OUT        IF $DATA(DTOUT)

               IF DTOUT=1

                   SET PSNFLAG=1

 +1        IF X="^"

               SET PSNFLAG=1

 +2        QUIT