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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNONDF 2589 printed Nov 22, 2024@17:34:28 Page 2
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
