source: WorldVistAEHR/trunk/r/CMOP-PSX/PSXNOCMP.m

Last change on this file was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.1 KB
Line 
1PSXNOCMP ;BIR/WRT,HTW-Outpatient drugs not marked to send to CMOP ;[ 10/19/98 8:50 AM ]
2 ;;2.0;CMOP;**18,19,23**;11 Apr 97
3 ;Reference to ^PSDRUG( supported by DBIA #1983, #2367
4 W !!,"This report will print all drugs marked for Outpatient use which are non-",!,"controlled substances and are not marked to transmit to CMOP.",!
5 W "This report requires 132 columns."
6 W !,"You may queue the report to print, if you wish.",!!
7DVC 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
8QUEUE 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
9ENQ ;Called by Taskman to print all drugs marked for OP but not CMOP
10 U IO
11 S PSXPGCT=0,PSXPGLNG=IOSL-6 D TITLE,LOOPA
12DONE 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
13 Q
14TITLE I $D(IOF),IOF]"" W @IOF S PSXPGCT=PSXPGCT+1
15 W !,?33,"OUTPATIENT DRUGS NOT MARKED TO SEND TO CMOP"
16 S X="T" D ^%DT X ^DD("DD") W !,?100,"Date printed: ",Y,!?100,"Page: ",PSXPGCT,!
17 W !,"LOCAL DRUG NAME",?54,"STATUS",?75,"VA PRINT NAME",!
18 F MJT=1:1:132 W "-"
19 Q
20LOOPA S PSXAM="" F S PSXAM=$O(^PSDRUG("B",PSXAM)) Q:PSXAM="" D LOOP
21 Q
22LOOP 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
23 Q
24LOOP2 K CS S CS=$P($G(^PSDRUG(PSXB,0)),"^",3) I $G(CS)[1!$G(CS)[2 K CS Q ; Patch 23
25 S PSXDN=^PSDRUG(PSXB,"ND"),PSXGN=$P(PSXDN,"^",1),PSXVP=$P(PSXDN,"^",3)
26 S PSXCMOP=$$PROD2^PSNAPIS(PSXGN,PSXVP)
27 I $P($G(PSXCMOP),"^",3)=1 S PSXVAP=$P(PSXCMOP,"^") D STAT
28 Q
29STAT I '$D(^PSDRUG("AQ",PSXB)) D STAT1
30 Q
31STAT1 I '$D(^PSDRUG(PSXB,3)) S PSXSTAT="NOT MARKED" D WRITE
32 I $D(^PSDRUG(PSXB,3)),$P(^PSDRUG(PSXB,3),"^",1)=0 S PSXSTAT="DO NOT SEND" D WRITE
33 I $D(^PSDRUG(PSXB,3)),$P(^PSDRUG(PSXB,3),"^",1)="" S PSXSTAT="NOT MARKED" D WRITE
34 Q
35WRITE D:$Y>PSXPGLNG TITLE
36 W !,PSXAM,?54,PSXSTAT,?75,PSXVAP,!
37 Q
Note: See TracBrowser for help on using the repository browser.