- PSNEXC ;BIR/PTD&CCH&WRT-Report of attempted match drugs ;01/12/98 5:18 PM
- ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
- W !!,"This report should be run after the menu option ""Verify Matches"" and",!,"before the menu option ""Merge National Drug File Data Into Local File""."
- W !,"It gives you a hard copy of the items from your local drug file for which",!,"a match was attempted, but no match was made from the National Drug File."
- W !,"You may queue the report to print, if you wish.",!
- S MJLT=0 I '$O(^PSNTRAN(MJLT)) W !,"No Data has been generated.",!,"The Match routine should be run before selecting this option.",! K MJLT Q
- DVC K IO("Q"),%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^PSNEXC" S ZTDTH="" S ZTDESC="Report of Attempted Match Drugs" D ^%ZTLOAD K MJT,MJLT,%ZIS,POP,IOP,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 Entries Found"
- W @IOF S:$D(ZTQUEUED) ZTREQ="@" K PSNB,MJLT,MJT,PSNPGCT,PSNPGLNG,PSNOLD,ZTRTN,Y,XYZ,VV,PSNPRT,PSNDEA,IOP,POP,IO("Q") D ^%ZISC
- Q
- TITLE I $D(IOF),IOF]"" W @IOF S PSNPGCT=PSNPGCT+1
- W !,?32,"REPORT OF ATTEMPTED MATCH DRUGS",!
- S X="T" D ^%DT X ^DD("DD") W !,?55,"Date printed: ",Y,!,?55,"Page: ",PSNPGCT,!!
- W !,"LOCAL DRUG NAME",?42,"INACTIVE",?65,"DEA",!
- F MJT=1:1:80 W "-"
- Q
- LOOP F PSNB=0:0 S PSNB=$O(^PSNTRAN(PSNB)) Q:'PSNB D:$Y>PSNPGLNG TITLE I $D(^PSNTRAN(PSNB,0)),$P(^PSNTRAN(PSNB,0),"^",2)']"",$P(^PSNTRAN(PSNB,0),"^",8)]"" D LOOP1
- Q
- LOOP1 S PSNOLD=$P(^PSDRUG(PSNB,0),"^") W !!,PSNOLD S PSNPRT=1 I $D(^PSDRUG(PSNB,"I")),$P(^PSDRUG(PSNB,"I"),"^",1)]"" S Y=$P(^PSDRUG(PSNB,"I"),"^",1) X ^DD("DD") W ?42,Y
- S PSNDEA=$P(^PSDRUG(PSNB,0),"^",3) F XYZ=1:1:$L(PSNDEA) S VV=$E(PSNDEA,XYZ) I "0IMS"[VV W ?65,$P(^PSDRUG(PSNB,0),"^",3) Q
- Q
- PSNEXC ;BIR/PTD&CCH&WRT-Report of attempted match drugs ;01/12/98 5:18 PM
- +1 ;;4.0; NATIONAL DRUG FILE;; 30 Oct 98
- +2 WRITE !!,"This report should be run after the menu option ""Verify Matches"" and",!,"before the menu option ""Merge National Drug File Data Into Local File""."
- +3 WRITE !,"It gives you a hard copy of the items from your local drug file for which",!,"a match was attempted, but no match was made from the National Drug File."
- +4 WRITE !,"You may queue the report to print, if you wish.",!
- +5 SET MJLT=0
- IF '$ORDER(^PSNTRAN(MJLT))
- WRITE !,"No Data has been generated.",!,"The Match routine should be run before selecting this option.",!
- KILL MJLT
- QUIT
- DVC KILL IO("Q"),%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^PSNEXC"
- SET ZTDTH=""
- SET ZTDESC="Report of Attempted Match Drugs"
- DO ^%ZTLOAD
- KILL MJT,MJLT,%ZIS,POP,IOP,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 Entries Found"
- +1 WRITE @IOF
- IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- KILL PSNB,MJLT,MJT,PSNPGCT,PSNPGLNG,PSNOLD,ZTRTN,Y,XYZ,VV,PSNPRT,PSNDEA,IOP,POP,IO("Q")
- DO ^%ZISC
- +2 QUIT
- TITLE IF $DATA(IOF)
- IF IOF]""
- WRITE @IOF
- SET PSNPGCT=PSNPGCT+1
- +1 WRITE !,?32,"REPORT OF ATTEMPTED MATCH DRUGS",!
- +2 SET X="T"
- DO ^%DT
- XECUTE ^DD("DD")
- WRITE !,?55,"Date printed: ",Y,!,?55,"Page: ",PSNPGCT,!!
- +3 WRITE !,"LOCAL DRUG NAME",?42,"INACTIVE",?65,"DEA",!
- +4 FOR MJT=1:1:80
- WRITE "-"
- +5 QUIT
- LOOP FOR PSNB=0:0
- SET PSNB=$ORDER(^PSNTRAN(PSNB))
- IF 'PSNB
- QUIT
- IF $Y>PSNPGLNG
- DO TITLE
- IF $DATA(^PSNTRAN(PSNB,0))
- IF $PIECE(^PSNTRAN(PSNB,0),"^",2)']""
- IF $PIECE(^PSNTRAN(PSNB,0),"^",8)]""
- DO LOOP1
- +1 QUIT
- LOOP1 SET PSNOLD=$PIECE(^PSDRUG(PSNB,0),"^")
- WRITE !!,PSNOLD
- SET PSNPRT=1
- IF $DATA(^PSDRUG(PSNB,"I"))
- IF $PIECE(^PSDRUG(PSNB,"I"),"^",1)]""
- SET Y=$PIECE(^PSDRUG(PSNB,"I"),"^",1)
- XECUTE ^DD("DD")
- WRITE ?42,Y
- +1 SET PSNDEA=$PIECE(^PSDRUG(PSNB,0),"^",3)
- FOR XYZ=1:1:$LENGTH(PSNDEA)
- SET VV=$EXTRACT(PSNDEA,XYZ)
- IF "0IMS"[VV
- WRITE ?65,$PIECE(^PSDRUG(PSNB,0),"^",3)
- QUIT
- +2 QUIT
