PSXNOCMP ;BIR/WRT,HTW-Outpatient drugs not marked to send to CMOP ;[ 10/19/98 8:50 AM ]
;;2.0;CMOP;**18,19,23**;11 Apr 97
;Reference to ^PSDRUG( supported by DBIA #1983, #2367
W !!,"This report will print all drugs marked for Outpatient use which are non-",!,"controlled substances and are not marked to transmit to CMOP.",!
W "This report requires 132 columns."
W !,"You may queue the report to print, if you wish.",!!
DVC K IO("Q"),IOP,POP,%ZIS S %ZIS="QM",%ZIS("B")="" 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^PSXNOCMP" S ZTDTH="" S ZTDESC="Outpatient Drugs Not Marked to Send To CMOP Report" D ^%ZTLOAD K MJLT,MJT,%ZIS,POP,IOP,ZTSK D ^%ZISC Q
ENQ ;Called by Taskman to print all drugs marked for OP but not CMOP
U IO
S PSXPGCT=0,PSXPGLNG=IOSL-6 D TITLE,LOOPA
DONE W @IOF S:$D(ZTQUEUED) ZTREQ="@" K PSXB,MJLT,MJT,IOP,POP,IO("Q"),PSXAM,PSXCMOP,PSXDN,PSXGN,PSXSTAT,PSXPGCT,PSXPGLNG,Y,PSXVAP,PSXVP,X D ^%ZISC
Q
TITLE I $D(IOF),IOF]"" W @IOF S PSXPGCT=PSXPGCT+1
W !,?33,"OUTPATIENT DRUGS NOT MARKED TO SEND TO CMOP"
S X="T" D ^%DT X ^DD("DD") W !,?100,"Date printed: ",Y,!?100,"Page: ",PSXPGCT,!
W !,"LOCAL DRUG NAME",?54,"STATUS",?75,"VA PRINT NAME",!
F MJT=1:1:132 W "-"
Q
LOOPA S PSXAM="" F S PSXAM=$O(^PSDRUG("B",PSXAM)) Q:PSXAM="" D LOOP
Q
LOOP F PSXB=0:0 S PSXB=$O(^PSDRUG("B",PSXAM,PSXB)) Q:'PSXB I '$D(^PSDRUG(PSXB,"I")),$D(^PSDRUG(PSXB,2)),$P(^PSDRUG(PSXB,2),"^",3)["O",$D(^PSDRUG(PSXB,"ND")),$P(^PSDRUG(PSXB,"ND"),"^",2)]"" D LOOP2
Q
LOOP2 K CS S CS=$P($G(^PSDRUG(PSXB,0)),"^",3) I $G(CS)[1!$G(CS)[2 K CS Q ; Patch 23
S PSXDN=^PSDRUG(PSXB,"ND"),PSXGN=$P(PSXDN,"^",1),PSXVP=$P(PSXDN,"^",3)
S PSXCMOP=$$PROD2^PSNAPIS(PSXGN,PSXVP)
I $P($G(PSXCMOP),"^",3)=1 S PSXVAP=$P(PSXCMOP,"^") D STAT
Q
STAT I '$D(^PSDRUG("AQ",PSXB)) D STAT1
Q
STAT1 I '$D(^PSDRUG(PSXB,3)) S PSXSTAT="NOT MARKED" D WRITE
I $D(^PSDRUG(PSXB,3)),$P(^PSDRUG(PSXB,3),"^",1)=0 S PSXSTAT="DO NOT SEND" D WRITE
I $D(^PSDRUG(PSXB,3)),$P(^PSDRUG(PSXB,3),"^",1)="" S PSXSTAT="NOT MARKED" D WRITE
Q
WRITE D:$Y>PSXPGLNG TITLE
W !,PSXAM,?54,PSXSTAT,?75,PSXVAP,!
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSXNOCMP 2225 printed Dec 13, 2024@01:44:34 Page 2
PSXNOCMP ;BIR/WRT,HTW-Outpatient drugs not marked to send to CMOP ;[ 10/19/98 8:50 AM ]
+1 ;;2.0;CMOP;**18,19,23**;11 Apr 97
+2 ;Reference to ^PSDRUG( supported by DBIA #1983, #2367
+3 WRITE !!,"This report will print all drugs marked for Outpatient use which are non-",!,"controlled substances and are not marked to transmit to CMOP.",!
+4 WRITE "This report requires 132 columns."
+5 WRITE !,"You may queue the report to print, if you wish.",!!
DVC KILL IO("Q"),IOP,POP,%ZIS
SET %ZIS="QM"
SET %ZIS("B")=""
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^PSXNOCMP"
SET ZTDTH=""
SET ZTDESC="Outpatient Drugs Not Marked to Send To CMOP Report"
DO ^%ZTLOAD
KILL MJLT,MJT,%ZIS,POP,IOP,ZTSK
DO ^%ZISC
QUIT
ENQ ;Called by Taskman to print all drugs marked for OP but not CMOP
+1 USE IO
+2 SET PSXPGCT=0
SET PSXPGLNG=IOSL-6
DO TITLE
DO LOOPA
DONE WRITE @IOF
if $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL PSXB,MJLT,MJT,IOP,POP,IO("Q"),PSXAM,PSXCMOP,PSXDN,PSXGN,PSXSTAT,PSXPGCT,PSXPGLNG,Y,PSXVAP,PSXVP,X
DO ^%ZISC
+1 QUIT
TITLE IF $DATA(IOF)
IF IOF]""
WRITE @IOF
SET PSXPGCT=PSXPGCT+1
+1 WRITE !,?33,"OUTPATIENT DRUGS NOT MARKED TO SEND TO CMOP"
+2 SET X="T"
DO ^%DT
XECUTE ^DD("DD")
WRITE !,?100,"Date printed: ",Y,!?100,"Page: ",PSXPGCT,!
+3 WRITE !,"LOCAL DRUG NAME",?54,"STATUS",?75,"VA PRINT NAME",!
+4 FOR MJT=1:1:132
WRITE "-"
+5 QUIT
LOOPA SET PSXAM=""
FOR
SET PSXAM=$ORDER(^PSDRUG("B",PSXAM))
if PSXAM=""
QUIT
DO LOOP
+1 QUIT
LOOP FOR PSXB=0:0
SET PSXB=$ORDER(^PSDRUG("B",PSXAM,PSXB))
if 'PSXB
QUIT
IF '$DATA(^PSDRUG(PSXB,"I"))
IF $DATA(^PSDRUG(PSXB,2))
IF $PIECE(^PSDRUG(PSXB,2),"^",3)["O"
IF $DATA(^PSDRUG(PSXB,"ND"))
IF $PIECE(^PSDRUG(PSXB,"ND"),"^",2)]""
DO LOOP2
+1 QUIT
LOOP2 ; Patch 23
KILL CS
SET CS=$PIECE($GET(^PSDRUG(PSXB,0)),"^",3)
IF $GET(CS)[1!$GET(CS)[2
KILL CS
QUIT
+1 SET PSXDN=^PSDRUG(PSXB,"ND")
SET PSXGN=$PIECE(PSXDN,"^",1)
SET PSXVP=$PIECE(PSXDN,"^",3)
+2 SET PSXCMOP=$$PROD2^PSNAPIS(PSXGN,PSXVP)
+3 IF $PIECE($GET(PSXCMOP),"^",3)=1
SET PSXVAP=$PIECE(PSXCMOP,"^")
DO STAT
+4 QUIT
STAT IF '$DATA(^PSDRUG("AQ",PSXB))
DO STAT1
+1 QUIT
STAT1 IF '$DATA(^PSDRUG(PSXB,3))
SET PSXSTAT="NOT MARKED"
DO WRITE
+1 IF $DATA(^PSDRUG(PSXB,3))
IF $PIECE(^PSDRUG(PSXB,3),"^",1)=0
SET PSXSTAT="DO NOT SEND"
DO WRITE
+2 IF $DATA(^PSDRUG(PSXB,3))
IF $PIECE(^PSDRUG(PSXB,3),"^",1)=""
SET PSXSTAT="NOT MARKED"
DO WRITE
+3 QUIT
WRITE if $Y>PSXPGLNG
DO TITLE
+1 WRITE !,PSXAM,?54,PSXSTAT,?75,PSXVAP,!
+2 QUIT
