- 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 Feb 18, 2025@23:50:44 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