source: WorldVistAEHR/trunk/r/CMOP-PSX/PSXUNREL.m@ 1006

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

initial load of WorldVistAEHR

File size: 6.2 KB
Line 
1PSXUNREL ;BIR/WPB-Report of Rx's Not Released by the Vendor ;29 Jun 2001 2:34 PM
2 ;;2.0;CMOP;**23,28,34,38**;11 Apr 97
3 ;Reference to CMOP^PSNAPIS supported by DBIA #2574
4EN I '$D(^PSX(552.4,"AR")) W !,"All Rx's have been released." Q
5 D EX
6 S DIC=552.1,DIC(0)="AEQMZ",DIC("A")="Select CMOP Batch # or RETURN for all: "
7 D ^DIC K DIC I $D(DUOUT)!($D(DTOUT))!(X["^") G EX
8 K DIRUT,DTOUT
9 S:+Y>0 PSXBEG=+Y K Y,X
10 S PSXANS=""
11 I $G(PSXBEG) G DEV
12Q1 S DIR(0)="S^C:Controlled Subs;N:Non-Controlled Subs;B:Both",DIR("?")="Enter ""C"" to report controlled substances, ""N"" for non-controlled substances or ""B"" to include both."
13 D ^DIR K DIR S PSXANS=$G(Y) I $D(DIRUT) K Y,X D EX G EN
14 D DATE Q:$G(STOP)
15DEV S %ZIS="Q",%ZIS("B")="HOME" D ^%ZIS S PSXLION=ION,PGL=($G(IOSL)-2) I POP W !,"NO DEVICE SELECTED" G EX
16 I $D(IO("Q")) D QUE,EX Q
17 G:$G(PSXBEG)>0 JOB
18 D JOBA,EX
19 Q
20DATE ;DATE SECTION
21 K STOP
22 S %DT="AEXT",%DT("A")="Enter to BEGIN SUMMARY: ",%DT(0)="-DT",%DT("B")="TODAY"
23 D ^%DT K %DT("A")
24 I Y<0!($D(DTOUT)) S STOP=1 Q
25 S START=Y
26 S %DT("A")="Enter date to END SUMMARY: ",%DT(0)="-DT",%DT("B")="TODAY" D ^%DT
27 K %DT
28 I Y<0!($D(DTOUT)) S STOP=1 Q
29 S END=Y\1+.24
30 I END<START W !,"Ending date must follow starting date!" G DATE
31DIVISION ;
32 S ZZFAC1=0,DIC=552,DIC(0)="AEQMZ",DIC("A")="Select FACILITY or RETURN for all: "
33 D ^DIC K DIC I $D(DUOUT)!($D(DTOUT))!(X["^") G EX
34 S:$G(Y)'>0 ALL=1,FAC1=0 Q:$G(Y)'>0
35 I +Y>0 S ZZFAC1=$$GET1^DIQ(552,+Y,5)
36 ; getting site/divnum
37 I ZZFAC1'>0 S XX=$P(Y,U,2)_",",ZZFAC1=$$GET1^DIQ(4,XX,99)
38 K Y,X,DIC,DUOUT,DTOUT
39 Q
40QUE S ZTRTN=$S($G(PSXBEG)>0:"JOB^PSXUNREL",$G(PSXBEG)="":"JOBA^PSXUNREL",1:""),ZTDESC="CMOP Unreleased Rx Report",ZTIO=PSXLION
41 F X="PSXBEG","PGL","PSXANS","START","END","ZZFAC1" S ZTSAVE(X)=""
42 D ^%ZTLOAD
43 I $D(ZTSK)[0 W !!,"Job Canceled"
44 E W !!,"Job Queued"
45 Q
46 ;Called by Taskman to run Report of Rx's not released by Vendor
47JOB S:$D(ZTQUEUED) ZTREQ="@"
48 I '$D(ZTQUEUED) U IO
49 I $G(PSXBEG) S RC5=$O(^PSX(552.4,"B",PSXBEG,"")),REC5=$P(^PSX(552.4,RC5,0),"^",1),REC5=REC5-1,PSXEND=REC5+1 D JOB1 G:$G(STOP) EX
50 I $G(IOST)["C-" S DIR(0)="E",DIR("A")="<CR> - CONTINUE" D ^DIR G EX
51 G EX
52 Q
53 ;Called by Taskman to run Report of Rx's not released by Vendor
54 ; information stored for printing
55 ; S ^TMP($J,"PSX",BAT)=ATM_U_TDTM_U_REC5
56 ; S ^TMP($J,"PSX",BAT,"TYP")=PSXTYP
57 ; S ^TMP($J,"PSX",BAT,ORDER,RX,FILL)=VAPRT_U_DRGID
58 ;
59JOBA S REC5=0,PSXEND=999999999
60 S:$D(ZTQUEUED) ZTREQ="@"
61 I '$D(ZTQUEUED) U IO
62JOB1 ;(515,"AR",IEN514,RXN)
63 K ^TMP($J,"PSX")
64 S $P(LINE,"-",IOM-1)=""
65 F S REC5=$O(^PSX(552.4,"AR",REC5)) Q:REC5'>0!(REC5>PSXEND) D
66 .I '$D(^PSX(552.1,REC5)) Q
67 .I $D(START) I START'=0 S ZZCHKDT=$P(^PSX(552.1,REC5,0),U,6) Q:((ZZCHKDT<START)!(ZZCHKDT>END))
68 .I $D(ZZFAC1) I ZZFAC1>0 Q:ZZFAC1'=$P(^PSX(552.1,REC5,0),"-")
69 .S ATM=$P($G(^PSX(552.1,REC5,0)),U,6) Q:$G(ATM)']""
70 .S BAT=$P(^PSX(552.1,REC5,0),U,1)
71 .S TDTM=$P(^PSX(552.1,REC5,0),U,3),REC4=$O(^PSX(552.4,"B",REC5,""))
72 .S ^TMP($J,"PSX",BAT)=ATM_U_TDTM_U_REC5
73 .S RX="" F S RX=$O(^PSX(552.4,"AR",REC5,RX)) Q:RX="" D JOB2
74 .I '$D(^TMP($J,"PSX",BAT,"TYP")) K ^TMP($J,"PSX",BAT)
75 .S:$D(DIRUT) REC5=99999999999999
76 D JOB3
77 K REC,PSXEND,PSXBEG,AREC,BAT,TDTM,ATM,OLDBAT,RECD,DRGID,FILL
78 K SITEN,ST,SITE,PHAR,LCNT,LINE,REC4,REC5,RC5,DIRUT,RX
79 Q
80JOB2 ;store information
81 S RECD=$O(^PSX(552.4,REC4,1,"B",RX,"")) Q:$G(RECD)=""
82 S PSXTYP=$P($G(^PSX(552.4,REC4,1,RECD,0)),U,14)
83 I $G(PSXANS)="N",PSXTYP=1 Q
84 I $G(PSXANS)="C",PSXTYP="" Q
85 Q:$D(DIRUT)
86 S DRGID=$P(^PSX(552.4,REC4,1,RECD,0),U,4),(NDFPTR,VAPRT)=""
87 D ORDNUM
88 S ORDER=$S($L(CORDER(1)):CORDER(1),1:"NONE")
89 I $G(DRGID)]"" S VAPRT=$$CMOP^PSNAPIS(DRGID)
90 S FILL=$P(^PSX(552.4,REC4,1,RECD,0),U,12)
91 S VAPRT=$G(VAPRT)
92 S ^TMP($J,"PSX",BAT,ORDER,RX,FILL)=VAPRT_U_DRGID
93 I $G(^TMP($J,"PSX",BAT,"TYP")) Q
94 S ^TMP($J,"PSX",BAT,"TYP")=PSXTYP
95 Q
96JOB3 ;Print records from ^TMP
97 K STOP
98 I '$D(^TMP($J,"PSX")) D G EX
99 .W @IOF,!!,?15,"NO UNRELEASED DATA TO PRINT",!!
100 . I $E(IOST)="C" S DIR(0)="E",DIR("A")="<cr> - continue" D ^DIR K DIR
101 S BAT="" F S BAT=$O(^TMP($J,"PSX",BAT)) Q:BAT="" S ZN=^(BAT) D Q:$G(STOP)
102 . S ATM=$P(ZN,U),TDTM=$P(ZN,U,2),REC5=$P(ZN,U,3)
103 . D HDR,ORDER,PG1
104 Q
105ORDER ;Print by order,rx,fill
106 S ORDER=""
107 F S ORDER=$O(^TMP($J,"PSX",BAT,ORDER)) Q:ORDER="" S RX="" D Q:$G(STOP)
108 . F S RX=$O(^TMP($J,"PSX",BAT,ORDER,RX)) Q:RX="" S FILL="" D Q:$G(STOP)
109 ..F S FILL=$O(^TMP($J,"PSX",BAT,ORDER,RX,FILL)) Q:FILL="" S ZN=^(FILL) D Q:$G(STOP)
110 ... S VAPRT=$P(ZN,U),DRGID=$P(ZN,U,2)
111 ... W !,ORDER,?18,RX,?28,FILL,?33,$E($G(VAPRT),1,35),?70,DRGID
112 ... D PG
113 Q
114ORDNUM ;Return Order Number
115 K CORDER
116 S CORDER=BAT,CORDER(1)=""
117 F S CORDER=$O(^PSX(552.2,"B",CORDER)) D Q:((CORDER="")!(CORDER(1)'=""))
118 .I $P(CORDER,"-",1,2)'=BAT S CORDER="" Q
119 .S ZZNODE=$O(^PSX(552.2,"B",CORDER,0)) Q:ZZNODE<1
120 .S:$D(^PSX(552.2,"AC",ZZNODE,RX)) CORDER(1)=CORDER
121 Q
122HDR W @IOF
123 D NOW^%DTC
124 S SITEN=+BAT
125 ;N X,Y S DIC=4,DIC(0)="MNZ",X=SITEN S:$D(^PSX(552,"D",X)) X=$E(X,2,99) D ^DIC S SITE=$S($G(Y)]"":$P(Y,"^",2),1:"UNKNOWN") K X,Y,DIC ;****DOD L1
126 N X,Y S X=SITEN,AGNCY="VASTANUM" S:$D(^PSX(552,"D",X)) AGNCY="DMIS",X=$E(X,2,99) S SITE=$$IEN^XUMF(4,AGNCY,X),SITE=$S($G(SITE)]"":$$NAME^XUAF4(SITE),1:"UNKNOWN") K X,Y,AGNCY ;****DOD L1
127 S PHAR=$P(^PSX(552.1,REC5,"P"),U,1)
128 S PSXTYP=^TMP($J,"PSX",BAT,"TYP")
129 S PSXTYP=$S(+PSXTYP:"Controlled Substance",1:"Non-Controlled Substance")
130 W !,?15,"Report of Unreleased Rxs for Transmission ",BAT
131 W !,?23,"Printed : ",$$FMTE^XLFDT(%,"1P"),!
132 W !,"Facility: ",SITE,?41,"Pharmacy Division: ",PHAR
133 W !,"Transmitted: ",$$FMTE^XLFDT(TDTM,"1P"),?41,"Received: ",$$FMTE^XLFDT(ATM,"1P")
134 W !,"Batch Type: ",PSXTYP,!!
135 W "ORDER #",?18,"RX NUMBER",?28,"FILL",?33,"DRUG NAME",?70,"DRUG ID",!,LINE
136 W !
137 Q
138PG ;line handler
139 I (($Y+3)<IOSL) Q
140 I $G(IOST)["P-" D HDR Q
141 S DIR(0)="E" D ^DIR K DIR,DIR(0) S:$D(DIRUT) STOP=1
142 K DIROUT,DTOUT,DUOUT,DIRUT
143 D:'$G(STOP) HDR
144 Q
145PG1 ;
146 I $E(IOST)'="C" Q
147 K DIR
148 S DIR(0)="E" D ^DIR K DIR,DIR(0) S:$D(DIRUT) STOP=1
149 K DIROUT,DTOUT,DUOUT,DIRUT
150 Q
151EX ;
152 K LINE,PHAR,BAT,SITE,OLDBAT,REC,TDTM,SUB,RECD,DRGID,FILL,LCNT,RCD,%,SITEN,X,ST,ATM,%,%ZIS,PSXLION,ZTDESC,ZTIO,ZTRTN,ZTSAVE("PSXBEG"),ZTSK
153 K DUOUT,DTOUT,X,Y,RC5,REC4,DIROUT,DIR,DIR(0),ZTQUEUED,STOP,PSXANS,VAPRT,NDFPTR
154 K FAC1,START,END,PSXTYP,STOP,PSXBEG,CORDER
155 K ALL,ORDER,PGL,ZN,ZZCHKDT,ZZFAC,ZZNODE,ZZXC,ZZXX,ZZFAC1
156 K ^TMP($J,"PSX")
157 W @IOF
158 D ^%ZISC
159 Q
Note: See TracBrowser for help on using the repository browser.