- 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 Jan 18, 2025@02:45:48 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