Routine: PSXNOCMP

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

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

LOOPA S PSXAM="" F  S PSXAM=$O(^PSDRUG("B",PSXAM)) Q:PSXAM=""  D LOOP

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

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

STAT  I '$D(^PSDRUG("AQ",PSXB)) D STAT1

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

WRITE D:$Y>PSXPGLNG TITLE

 W !,PSXAM,?54,PSXSTAT,?75,PSXVAP,!

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

PSXNOCMP.m