Produced by Araxis Merge on 11/9/2018 12:33:59 AM Central Standard Time. See www.araxis.com for information about Merge. This report uses XHTML and CSS2, and is best viewed with a modern standards-compliant browser. For optimum results when printing this report, use landscape orientation and enable printing of background images and colours in your browser.
# | Location | File | Last Modified |
---|---|---|---|
1 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMKMBM.m | Mon Nov 5 16:42:08 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMKMBM.m | Mon Nov 5 17:49:05 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 3 | 380 |
Changed | 2 | 8 |
Inserted | 0 | 0 |
Removed | 0 | 0 |
Whitespace | |
---|---|
Character case | Differences in character case are significant |
Line endings | Differences in line endings (CR and LF characters) are ignored |
CR/LF characters | Not shown in the comparison detail |
No regular expressions were active.
1 | CHMKMBM ;J AK/DEN;MON THLY DRUG AUDIT REPO RT;01/25/1 0 9:36 AM | |
2 | ;;1.0;CHA MPVA SYSTE M;;March 1 2, 2010;Bu ild 2 | |
3 | ; | |
4 | ;DEV01289 3 1/17/201 4 DGC - MO DIFY IO | |
5 | ;MTN02426 5 09/23/15 SBB - Fix the DECNE T routines that have a typo | |
6 | ; | |
7 | ZSET S:'$D (DUZ) DUZ= 1,DUZ(0)=" " I '$D(DT ) S %DT="" ,X="T" D ^ %DT S DT=Y | |
8 | S:'$D(IOZ FO) IOZFO= "^^" S:'$D (IOZBK) IO ZBK="^" S: '$D(DTIME) DTIME=120 | |
9 | S T=$C(9) | |
10 | ;set var IOF for cl ear screen | |
11 | S:'$D(IOF ) IOF="#,$ C(27,91,50 ,74,27,91, 72)" | |
12 | I '$D(IOZ ) S %IS="N ",IOP=$I D ^%ZIS K I OP S IOZ=I O,IOZL=IOS L,IOZW=IOM ,IOZF=IOF, IOZT=IOST, IOZN=ION,I OZS=IOS | |
13 | S:$D(IOF) IOZF=IOF | |
14 | MAIN ; mai n paragrap h | |
15 | D PROMPT | |
16 | I $D(DRUG )>0&(Y'="^ ^") D | |
17 | .D TSKMAN | |
18 | E D | |
19 | .W !,"Dru g, Start D ate, and E nd Date ar e required to genera te report. " | |
20 | D EXIT | |
21 | Q | |
22 | TSKMAN ; queueing t ask using Taskman... will gener ate 2 mail man report s and 2 sp readsheet files for Dublin, GA | |
23 | S ION="" | |
24 | X ^%ZOSF( "UCI") S C HUCI=$P(Y, ",",1) | |
25 | X "D $SYS TEM.Proces s.SetZEOF( 1)" ;DGC 7 /30/2015 D EV012893 | |
26 | S FILE1=" MBMAuditRe port1_"_$E (DT,2,7)_" _"_DUZ_".X LS" | |
27 | S FILE2=" MBMAuditRe port2_"_$E (DT,2,7)_" _"_DUZ_".X LS" | |
28 | I CHUCI=" HAC" D | |
29 | .S MBM1=" HACFS3"" DNS decnet HAC dec741!"": :D:[FS3BIG .MBM_REPOR TS.DUBLIN] "_FILE1 | |
30 | .S MBM2=" HACFS3"" DNS decnet HAC dec741!"": :D:[FS3BIG .MBM_REPOR TS.DUBLIN] "_FILE2 | |
31 | .W !,"DAT A WILL BE WRITTEN TO [FS3BIG\M BM_REPORTS \DUBLIN] " | |
32 | E D | |
33 | .S MBM1=" HACFS3"" DNS decnet HAC dec741!"": :D:[FS3BIG .MBM_REPOR TS.DUBLIN] "_"TEST_"_ FILE1 | |
34 | .S MBM2=" HACFS3"" DNS decnet HAC dec741!"": :D:[FS3BIG .MBM_REPOR TS.DUBLIN] "_"TEST_"_ FILE2 | |
35 | .W !,"THI S TEST DAT A WILL BE WRITTEN TO [FS3BIG\M BM_REPORTS \DUBLIN] " | |
36 | S CHFIO=" " | |
37 | S ZTRTN=" QUERY^CHMK MBM",ZTDES C="MBM PRE SCRIPTION RPT" | |
38 | S ZTDTH=$ H S ZTIO=" " | |
39 | S ZTSAVE( "CHFIO")=" ",ZTSAVE(" *")="" | |
40 | D ^%ZTLOA D | |
41 | ;D QUERY^ CHMKMBM ; FOR TEST ING/DEBUGG ER | |
42 | D HOME^%Z IS | |
43 | Q | |
44 | PROMPT ; | |
45 | W @IOF | |
46 | K ^CHMZHO LD($J,"MBM PRESCRIPT TECH") S ^CHMZHOLD( $J,"MBM PR ESCRIPT TE CH")=$H | |
47 | K ^CHMZHO LD($J,"MBM PRESCRIPT PHARM") S ^CHMZHOLD ($J,"MBM P RESCRIPT P HARM")=$H | |
48 | K ^TMP($J ) | |
49 | S TITLE=" MEDS BY MA IL - MONTH LY DRUG AU DIT REPORT " | |
50 | W !,TITLE ,!!! | |
51 | DRUG ; DRU G PROMPT | |
52 | ;S DIR("A ")="DRUG/P RODUCT NAM E" | |
53 | S DIR(0)= "PO^50:DIC (0)=""AEQM """ D ^DIR K DIR | |
54 | G:Y=""!(Y =-1) SDATE | |
55 | Q:$D(DUOU T)!($D(DIR OUT)) | |
56 | S DRUGNAM E=Y | |
57 | S DRUG($P (DRUGNAME, "^",1))=$P (DRUGNAME, "^",2) | |
58 | G DRUG | |
59 | SDATE ; da te prompts | |
60 | W ! | |
61 | S DIR(0)= "D" S DIR( "A")="Plea se enter s tart date (MM/DD/YY) " D ^DIR S STR=Y K D IR | |
62 | Q:STR="^^ " | |
63 | G:STR=""! (STR="^")! (STR=-1) D RUG | |
64 | I STR>DT W !!,"Ple ase do not enter a f uture date !",! G SDA TE | |
65 | EDATE | |
66 | S DIR(0)= "D" S DIR( "B")=$$FMT E^XLFDT(DT ,"2DZ") S DIR("A")=" Please ent er end dat e (MM/DD/Y Y)" D ^DI R S END=Y K DIR | |
67 | Q:END="^^ " | |
68 | G:END=""! (END="^")! (END=-1) S DATE | |
69 | I STR>END D SDATE | |
70 | I END>DT W !!,"Ple ase do not enter a f uture date !",! G EDA TE | |
71 | Q | |
72 | QUERY ;que ry for spe cific pres criptions based upon prompt | |
73 | S CTR=0,M BMCTR=0 | |
74 | S I=0 F S I=$O(^PS RX(I)) Q:' I!(I'>0) D ; there isn't a c ross-ref b etween dru g and pres cription; therefore long query time | |
75 | .S D=0 F S D=$O(DR UG(D)) Q:' D!(D'>0) D | |
76 | ..I D=($P (^PSRX(I,0 ),"^",6))& ($D(^PSRX( I,"OR1"))) D | |
77 | ...S DRG= D | |
78 | ...S DRGN =$E(DRUG(D ),1,10) | |
79 | ...S DV=$ P(^PSRX(I, 2),"^",9) | |
80 | ...I DV=2 !(DV=4) D | |
81 | ....S RXN =$P(^PSRX( I,0),"^",1 ) | |
82 | ....S PT= $P(^PSRX(I ,0),"^",2) | |
83 | ....S PTN =$P(^DPT(P T,0),"^",1 ) | |
84 | ....S PTS SN=$P(^DPT (PT,0),"^" ,9) | |
85 | ....S ENT =$P(^PSRX( I,0),"^",1 6) | |
86 | ....S ENT N=$TR($P($ P(^VA(200, ENT,0),"^" ,1),",",1) _","_$E($P ($P(^VA(20 0,ENT,0)," ^",1),",", 2),1),"ZZ" ,"") | |
87 | ....S VPH RM=$P(^PSR X(I,2),"^" ,10) | |
88 | ....S FDT =$E($P(^PS RX(I,"OR1" ),"^",8),1 ,7) ; unfo rmatted fo r date com parison | |
89 | ....I FDT '=""&(VPHR M'="") D | |
90 | .....I ST R<=FDT&(FD T<=END) D | |
91 | ......S F DATE=$$FMT E^XLFDT($E ($P(^PSRX( I,"OR1")," ^",8),1,7) ,"2DZ") ; formatted before sto rage | |
92 | ......S V PHRMN=$P($ P(^VA(200, VPHRM,0)," ^",1),",", 1)_","_$E( $P($P(^VA( 200,VPHRM, 0),"^",1), ",",2),1) | |
93 | ......D R CD | |
94 | D OUTPUT | |
95 | D EXIT | |
96 | Q | |
97 | RCD ; popu late hold area | |
98 | S MBMCTR= MBMCTR+1 | |
99 | S ^CHMZHO LD($J,"MBM PRESCRIPT TECH",ENT N,+D,+FDT) =ENTN_"^"_ VPHRMN_"^" _FDATE_"^" _PTN_"^"_D RGN_"^"_RX N_"^"_DV | |
100 | S ^CHMZHO LD($J,"MBM PRESCRIPT PHARM",+P TSSN,+D,+F DT)=PTSSN_ "^"_PTN_"^ "_RXN_"^"_ DRGN_"^"_F DATE_"^"_D V | |
101 | Q | |
102 | OUTPUT ; g enerate co mpleted re ports | |
103 | S TODAY=$ $FMTE^XLFD T(DT,"2DZ" ) | |
104 | S START=$ $FMTE^XLFD T(STR,"2DZ ") | |
105 | S ENDDT=$ $FMTE^XLFD T(END,"5DZ ") | |
106 | S NDATA=" NO DATA ME T SELECTED CRITERIA" | |
107 | D HSBH | |
108 | ;REPORT1: for techn ician to p ull hardco py files f rom storag e | |
109 | I MBMCTR' =0 D | |
110 | .S L="" F S L=$O(^ CHMZHOLD($ J,"MBM PRE SCRIPT TEC H",L)) Q:L ="" D | |
111 | ..S M=0 F S M=$O(^ CHMZHOLD($ J,"MBM PRE SCRIPT TEC H",L,M)) Q :'M D | |
112 | ...S N=0 F S N=$O( ^CHMZHOLD( $J,"MBM PR ESCRIPT TE CH",L,M,N) ) Q:'N D | |
113 | ....S TR= ^CHMZHOLD( $J,"MBM PR ESCRIPT TE CH",L,M,N) | |
114 | ....S ^TM P($J,"MBM PRESCRIPT TECH",CTR) =$J($E($P( TR,"^",1), 1,10),10)_ " "_$J($E( $P(TR,"^", 2),1,9),9) _" "_$J($P (TR,"^",3) ,8)_" "_$J ($E($P(TR, "^",4),1,2 9),29)_" " _$J($P(TR, "^",5),10) _" "_$J($P (TR,"^",6) ,8),CTR=CT R+1 | |
115 | ....D CRF ILE1 | |
116 | E D | |
117 | .S ^TMP($ J,"MBM PRE SCRIPT TEC H",CTR)=ND ATA U MBM1 W !,NDATA | |
118 | S XMTEXT= "^TMP($J," "MBM PRESC RIPT TECH" "," | |
119 | S XMDUZ=. 5 | |
120 | S XMY(DUZ )="" | |
121 | S XMSUB=T ITLE1 D ^X MD | |
122 | ;REPORT2: for medic ation safe ty pharmac ist to loo kup patien t records in VISTA | |
123 | I MBMCTR' =0 D | |
124 | .S O=0 F S O=$O(^C HMZHOLD($J ,"MBM PRES CRIPT PHAR M",O)) Q:' O D | |
125 | ..S P=0 F S P=$O(^ CHMZHOLD($ J,"MBM PRE SCRIPT PHA RM",O,P)) Q:'P D | |
126 | ...S Q=0 F S Q=$O( ^CHMZHOLD( $J,"MBM PR ESCRIPT PH ARM",O,P,Q )) Q:'Q D | |
127 | ....S PR= ^CHMZHOLD( $J,"MBM PR ESCRIPT PH ARM",O,P,Q ) | |
128 | ....S ^TM P($J,"MBM PRESCRIPT PHARM",CTR )=$J($P(PR ,"^",1),9) _" "_$J($P (PR,"^",2) ,30)_" "_$ J($P(PR,"^ ",3),8)_" "_$J($P(PR ,"^",4),10 )_" "_$J($ P(PR,"^",5 ),10),CTR= CTR+1 | |
129 | ....D CRF ILE2 | |
130 | E D | |
131 | .S ^TMP($ J,"MBM PRE SCRIPT PHA RM",CTR)=N DATA U MBM 2 W !,NDA TA | |
132 | S XMTEXT= "^TMP($J," "MBM PRESC RIPT PHARM ""," | |
133 | S XMDUZ=. 5 | |
134 | S XMY(DUZ )="" | |
135 | S XMSUB=T ITLE2 D ^X MD | |
136 | Q | |
137 | HSBH ;REPO RT1: for t echnician to pull ha rdcopy fil es from st orage | |
138 | ;REPORT1 headings a nd subhead ings for m ailman | |
139 | S CTR=1,^ TMP($J,"MB M PRESCRIP T TECH",CT R)="",CTR= CTR+1 | |
140 | S TITLE1= "MEDS BY M AIL DRUG A UDIT REPOR T -- RETRI EVE HARDCO PY FILES" | |
141 | S ^TMP($J ,"MBM PRES CRIPT TECH ",CTR)=TIT LE1,CTR=CT R+1 | |
142 | S ^TMP($J ,"MBM PRES CRIPT TECH ",CTR)="", CTR=CTR+1 | |
143 | S ^TMP($J ,"MBM PRES CRIPT TECH ",CTR)="RE PORT DATE: "_TODAY,C TR=CTR+1 | |
144 | S ^TMP($J ,"MBM PRES CRIPT TECH ",CTR)="", CTR=CTR+1 | |
145 | S ^TMP($J ,"MBM PRES CRIPT TECH ",CTR)="RE PORT RANGE : "_START_ " - "_ENDD T,CTR=CTR+ 1 | |
146 | S ^TMP($J ,"MBM PRES CRIPT TECH ",CTR)="", CTR=CTR+1 | |
147 | S ^TMP($J ,"MBM PRES CRIPT TECH ",CTR)=" ENTER BY V ER.PHRM. F.DATE PATIE NT NAME D RUG NAME RX NO.",C TR=CTR+1 | |
148 | S ^TMP($J ,"MBM PRES CRIPT TECH ",CTR)="-- ---------- ---------- ---------- ---------- ---------- ---------- ---------- -------",C TR=CTR+1 | |
149 | S ^TMP($J ,"MBM PRES CRIPT TECH ",CTR)="", CTR=CTR+1 | |
150 | ;REPORT1 headings a nd subhead ings for f ile | |
151 | I '$$OPEN FIWR^CHTFL IB9(.MBM1, "MBM1") X "D $SYSTEM .Process.S etZEOF(0)" Q ;DGC 7/ 30/2015 DE V012893 ;O MBM1:"WRN S":5 Q:$T= 0 - DGC 1/ 17/2014 DE V012893 | |
152 | U MBM1 W !,"DUZ:",T ,DUZ | |
153 | U MBM1 W !!,TITLE1 | |
154 | U MBM1 W !!,"REPORT RAN ON:", T,TODAY | |
155 | U MBM1 W !,"REPORT FOR:",T,ST ART," TO " ,ENDDT | |
156 | U MBM1 W !!!!! | |
157 | U MBM1 W "ENTERED B Y",T,"VERI FYING PHAR MACIST",T, "FINISH DA TE",T,"PAT IENT NAME" ,T,"DRUG N AME",T,"RX NUMBER" | |
158 | U MBM1 W !,"------- ---",T,"-- ---------- --------", T,"------- ----",T,"- ---------- -",T,"---- -----",T," ---------" | |
159 | ;REPORT2: for medic ation safe ty pharmac ist to loo kup patien t records in VISTA | |
160 | ;REPORT2 headings a nd subhead ings for m ailman | |
161 | S CTR=1,^ TMP($J,"MB M PRESCRIP T PHARM",C TR)="",CTR =CTR+1 | |
162 | S TITLE2= "MEDS BY M AIL DRUG A UDIT REPOR T -- PATIE NT LOOKUP" | |
163 | S ^TMP($J ,"MBM PRES CRIPT PHAR M",CTR)=TI TLE2,CTR=C TR+1 | |
164 | S ^TMP($J ,"MBM PRES CRIPT PHAR M",CTR)="" ,CTR=CTR+1 | |
165 | S ^TMP($J ,"MBM PRES CRIPT PHAR M",CTR)="R EPORT DATE : "_TODAY, CTR=CTR+1 | |
166 | S ^TMP($J ,"MBM PRES CRIPT PHAR M",CTR)="" ,CTR=CTR+1 | |
167 | S ^TMP($J ,"MBM PRES CRIPT PHAR M",CTR)="R EPORT RANG E: "_START _" - "_END DT,CTR=CTR +1 | |
168 | S ^TMP($J ,"MBM PRES CRIPT PHAR M",CTR)="" ,CTR=CTR+1 | |
169 | S ^TMP($J ,"MBM PRES CRIPT PHAR M",CTR)="S SN PAT IENT NAME RX NO. DRUG NAME F.DATE ",CTR=CTR+ 1 | |
170 | S ^TMP($J ,"MBM PRES CRIPT PHAR M",CTR)="- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ",CTR=CTR+ 1 | |
171 | S ^TMP($J ,"MBM PRES CRIPT PHAR M",CTR)="" ,CTR=CTR+1 | |
172 | ;REPORT2 headings a nd subhead ings for f ile | |
173 | I '$$OPEN FIWR^CHTFL IB9(.MBM2, "MBM2") X "D $SYSTEM .Process.S etZEOF(0)" Q ;DGC 7/ 30/2015 DE V012893 ;O MBM2:"WRN S":5 Q:$T= 0 - DGC 1/ 17/2014 DE V012893 | |
174 | U MBM2 W !,"DUZ:",T ,DUZ | |
175 | U MBM2 W !!,TITLE2 | |
176 | U MBM2 W !!,"REPORT RAN ON:", T,TODAY | |
177 | U MBM2 W !,"REPORT FOR:",T,ST ART," TO " ,ENDDT | |
178 | U MBM2 W !!!!! | |
179 | U MBM2 W "PATIENT S SN",T,"PAT IENT NAME" ,T,"RX NUM BER",T,"DR UG NAME",T ,"FINISH D ATE" | |
180 | U MBM2 W !,"------- ----",T,"- ---------- -",T,"---- -----",T," ---------" ,T,"------ -----" | |
181 | Q | |
182 | CRFILE1 ; for report 1 | |
183 | U MBM1 W !,$P(TR,"^ ",1),T,$P( TR,"^",2), T,$P(TR,"^ ",3),T,$P( TR,"^",4), T,$P(TR,"^ ",5),T,$P( TR,"^",6) | |
184 | Q | |
185 | CRFILE2 ; for report 2 | |
186 | U MBM2 W !,$P(PR,"^ ",1),T,$P( PR,"^",2), T,$P(PR,"^ ",3),T,$P( PR,"^",4), T,$P(PR,"^ ",5) | |
187 | Q | |
188 | EXIT ;clea r data | |
189 | K ^CHMZHO LD($J,"MBM PRESCRIPT TECH") | |
190 | K ^CHMZHO LD($J,"MBM PRESCRIPT PHARM") | |
191 | D CLOSEF^ CHTFLIB9(M BM1,"MBM1" ) D CLOSEF ^CHTFLIB9( MBM2,"MBM2 ") ;C MBM1 ,MBM2 - DG C 1/17/201 4 DEV01289 3 | |
192 | X "D $SYS TEM.Proces s.SetZEOF( 0)" ;DGC 7 /30/2015 D EV012893 | |
193 | K STR,END ,DRG,DRGN, DV,RXN,PT, ENT,VPHRM, PTSSN,ENTN ,VPHRMN,FD T | |
194 | Q |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.