Produced by Araxis Merge on 11/9/2018 12:34:06 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 | CHMMBM1P.m | Mon Nov 5 16:45:27 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMMBM1P.m | Mon Nov 5 17:50:52 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 3 | 538 |
Changed | 2 | 4 |
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 | CHMMBM1P ; HAC/JSG;NO ALLERGY A SSESSMENT / KNOWN AL LERGY REPO RT / EXPOR T (QUEUED) ;01/16/09; 10:10 AM | |
2 | ; Requiremen ts defined by: DEV00 4771-02 & BAT004771- 01 | |
3 | ; Keys: ALLE RGY ASSESS MENT, ADVE RSE REACTI ON, MBM, M EDS BY MAI L, AAR, KN OWN ALLERG Y, NKA; | |
4 | ; The routin e prints o r exports a list of CHAMPVA el igible pat ients that are activ e MbM | |
5 | ; beneficiar ies who ei ther (user selected) have: | |
6 | ; 1) not compl eted an al lergy asse ssment (NA A) | |
7 | ; 2) completed allergy a ssessment but have n o known al lergies on file (NKA ) | |
8 | ; The report s select b eneficiari es that ha ve a presc ription ac tive or 1 filled in the past | |
9 | ; year from the date o f the repo rt run. Ex ported lis ts are sav ed in Fs3b ig folder: MBMCMOP | |
10 | ; | |
11 | ; ;DEV012893 -08 YJK Ma r 2014 | |
12 | ; | |
13 | N POP | |
14 | S POP=0 | |
15 | N TYPE,STYL E,DEL,EM,T AB,IOFILE, QED,ALL,ST ATE | |
16 | S U="^",QED =0,XDUZ=DU Z Q:"^^@"[ $$CRITERIA ;R un time pa rameters | |
17 | I $D(IO("Q" ))!(TYPE=" E") S QED= 1 ;2 Q ! '2 Q | |
18 | S TAB=$S(DE L'="":DEL, 1:U) | |
19 | I F 'QED { D AAR W !!, "Report Co mplete," ; If 'Qing | |
20 | R " type <E nter> to c ontinue: " ,X:10 } | |
21 | E LSE { S Z TRTN="AAR^ CHMMBM1P" D VARSAVE, ^%ZTLOAD ;If Qing | |
22 | ;S IOP="HOME" D HOME^%Z IS ;'N ecessary | |
23 | W:$ D(ZTSK) !, "Your Task Number is : ",ZTSK R X:3 } | |
24 | Q | |
25 | ; | |
26 | CRITERIA() ;TYPE=P!E ;STYLE=A!K ;DEL=delim iter; | |
27 | S (TYPE,S TYLE,DEL,Q ED,TAB,IOF ILE,CHUCI, ALL,STATE) ="" | |
28 | W !!,"MbM Allergy A ssessment Report:",! | |
29 | W !,"This option wi ll produce a list or export fi le of acti ve, eligib le patient s" | |
30 | W !,"that have eith er No Alle rgy Assess ment (NAA) and/or No Known All ergies (NK A)" | |
31 | W !,"from all or se lected sta tes." | |
32 | W !!,"Con tinue?" Q: $$YN^ACKQU TL(1)<1 U W ! | |
33 | S ALL=$$A orS() Q:AL L=U U ;All p atients or those of a particul ar state | |
34 | IF ALL="S " { S STAT E=$$State( ) } ;Get a state | |
35 | ELSE { S STAT E=ALL } | |
36 | Q:STATE=U U | |
37 | S TYPE=$$ PorE() Q:T YPE=U U ;Print or export? | |
38 | I TYPE="E " S DEL=$$ DChar() Q: DEL="@" U S:DEL="<Ta b>" DEL=$C (9) ;D elimiter c haracter | |
39 | D NOW^%DT C S TODAY= X | |
40 | I TYPE="P " W !!,"Re port requi res a ""WI DE"" print er.",!! | |
41 | I S IOP= "Q" D ^%ZI S Q:POP U ;If pr inting, ge t device | |
42 | X ^%ZOSF( "UCI") S C HUCI=$P(Y, ",") | |
43 | IF TYPE=" P" { W !," Printing M bM No " | |
44 | W $S( STYLE="NAA ":"Allergy Assessmen t",1:"Know n Allergy" ) | |
45 | W " R eport to: ",IO,ION," .",! } | |
46 | ELSE { S IOFILE="AA R_"_DUZ_"_ "_TODAY_"_ "_($P($H," ,",2)\60) | |
47 | S:CHU CI'="HAC" IOFILE=IOF ILE_"_TST" S IOFILE= IOFILE_".T XT" | |
48 | W !!,"Export ing select ed AAR det ail to:" | |
49 | W !!,?22,"Da ta share: Fs3big",!, ?26,"Folde r: MBMCMOP " | |
50 | W !,?28,"Fil e: ",IOFIL E,! } | |
51 | Q 1 | |
52 | ; | |
53 | DFD(D) Q $ E(D,4,5)_" /"_$E(D,6, 7)_"/"_$E( D,2,3) ;Fo rmat date | |
54 | ; | |
55 | VARSAVE ;S ave variab les for qu eued job: | |
56 | S CHFIO=$G(I ON),ZTIO=" " S PAR=$$ VPACK | |
57 | S ZTDESC="Al lergy Asse ssment "_$ S(TYPE="P" :"Report", 1:"File Ex tract") | |
58 | S (ZTSAVE("C HFIO"),ZTS AVE("U"),Z TSAVE("PAR "))="" | |
59 | Q | |
60 | ; | |
61 | VPACK() Q $LB(TYPE,S TYLE,DEL,Q ED,TAB,TOD AY,IOFILE, CHUCI,XDUZ ,ALL,STATE ) | |
62 | ; | |
63 | VSET(P) S TYPE=$LI(P ,1),STYLE= $LI(P,2),D EL=$LI(P,3 ),QED=$LI( P,4),TAB=$ LI(P,5) | |
64 | S TODAY=$LI( P,6),IOFIL E=$LI(P,7) ,CHUCI=$LI (P,8),XDUZ =$LI(P,9) | |
65 | S ALL=$LI(P, 10),STATE= $LI(P,11) Q | |
66 | ; | |
67 | AAR ;Scan In-house Q ueue date entry inde x beginnin g with Sta rt Date: | |
68 | K ^TM P($J,"AAR" ) D:'$D(QE D) VSET(PA R) S IEN=0 ;Unpack | |
69 | S YR= $E(TODAY,2 ,3)-$S(CHU CI="DEV":2 ,CHUCI="TS T":2,1:1) ;Ma ke it 2 ye ars ago if testing | |
70 | S YRA GO=TODAY,$ E(YRAGO,2, 3)=$E("00" ,1,2-$L(YR ))_YR | |
71 | P ;Phar macy Patie nt File: | |
72 | S IEN =$O(^PS(55 ,IEN)) G A AREND:IEN' >0 ;Get a pharmacy patient | |
73 | K DFN ,BFN,BES | |
74 | G P:' $D(^PS(55, IEN,0),PP0 ) S PFN=$P (PP0,U) | |
75 | ;Pati ent file: | |
76 | I $D( ^DPT(PFN,. 35),DOD) G P:$P(DOD, U)>0 ;Skip, if deceased | |
77 | G P:' $$ACTIVE(I EN,YRAGO) ;Skip, i f no activ e pharmacy profile | |
78 | G P:' $D(^DPT(PF N,0),D0) ;Skip, i f no patie nt entry | |
79 | ;Adve rse Reacti on Assessm ent File ( Allergy As sessment): | |
80 | S (NA A,NKA)="" | |
81 | IF '$ D(^GMR(120 .86,"B",PF N)) { S NA A="___" } | |
82 | ELSE { S RA=$P( ^GMR(120.8 6,PFN,0),U ,2) | |
83 | IF 'RA { S NKA=" X " } | |
84 | ELSE { S PP=0,NK A=" X " | |
85 | ;Patient A llergies F ile: | |
86 | WHILE $O(^ GMR(120.8, "B",PFN,PP ))>0,NKA'= "" { S PP= $O(^(PP)) | |
87 | S PAM= $P(^GMR(12 0.8,PP,0), U,14) | |
88 | S NKA= $S(PAM="P" :" X ",1:" ") } } } | |
89 | G P:N AA'["_"&(N KA'["X") ; Neither NA A or NKA | |
90 | S PNA ME=$P(D0,U ),PSSN=$P( D0,U,9) K DOD,BES ;Get patient n ame, SSN | |
91 | ;CHAM PVA Benefi ciary File : | |
92 | IF PS SN'="" { | |
93 | I $D(^AHCHVA ("G",PSSN) ) { S DFN= $O(^AHCHVA ("G",PSSN, 0)) ;Chec k DOD, eli gibility | |
94 | IF DFN>0 { S BFN=$O (^AHCHVA(" G",PSSN,DF N,0)) | |
95 | IF BFN>0, $D(^AHCHVA (DFN,100,B FN,0),X) { | |
96 | S DOD= $P(X,U,6), BES=$P(X,U ,5) } ;D OD, eligib ility | |
97 | ELSE { K BFN,DOD } } | |
98 | EL SE { K DFN ,DOD } } | |
99 | ELSE { S PNAME= $E(PNAME,1 ,27)_$E(" ",$L (PNAME)+1, 27)_" **" } } | |
100 | G:$G(DOD )>0 P ;Sk ip, if dec eased | |
101 | P1 I $G(B ES)'="EA", PNAME'["*" G P ;S kip, if 'e ligible | |
102 | IF '$ D(^DPT(PFN ,.11),D11) { S (A1,A 2,A3,CTY,S T,ZIP)="" } ;Get address | |
103 | ELSE { S A1=$P( D11,U),A2= $P(D11,U,2 ),A3=$P(D1 1,U,3) | |
104 | S CTY=$P (D11,U,4), ST=$P(D11, U,5),ZIP=$ P(D11,U,6) } | |
105 | I ALL ="S",ST="" !(ST'=$P(S TATE,U,2)) G P ;Pa tient in n ot correct state for listing | |
106 | S ST= $P(^DIC(5, ST,0),U,2) ;Get state abbr eviation | |
107 | IF '$ D(^DPT(PFN ,.13),D13) { S PH="" } ;Get phone # | |
108 | ELSE { S PH=$P( D13,U) S:P H'="" PH=$ $AT(PH," [ R]") } | |
109 | IF PH ="" { ;If null,try o ther phone numbers | |
110 | IF $P (D13,U,2)' ="" { S PH =$$AT($P(D 13,U,2)," [W]") } | |
111 | ELSEI F $P(D13,U ,4)'="" { S PH=$$AT( $P(D13,U,4 )," [C]") } } | |
112 | IF PH="" ,$D(DFN),$ D(BFN) { ;If all n ull, try C HAMPVA dat abase for phone | |
113 | IF DF N>0,BFN>0, $D(^AHCHVA (DFN,100,B FN,1),X),$ P(X,U,6)'= "" { S PH= $P(X,U,6) | |
114 | IF $E(PH)?1N { S:PH?.N PH=$E(PH, 1,3)_"-"_$ E(PH,4,6)_ "-"_$E(PH, 7,10) | |
115 | S PH=$$ AT(PH," [B ]") } } } | |
116 | S:PSSN'= "" PSSN=$E (PSSN,1,3) _"-"_$E(PS SN,4,5)_"- "_$E(PSSN, 6,9) | |
117 | S X=N AA_U_NKA_U _PNAME_U_P SSN_U_PH_U _A1_U_A2_U _A3_U_CTY_ U_ST_U_ZIP | |
118 | S ^TM P($J,"AAR" ,STATE,PNA ME,PFN)=X ;Save for printing | |
119 | G P | |
120 | ; | |
121 | AT(P,T) ;( Phone, Typ e);Add pho ne type to phone # s tring: | |
122 | I $E(P)="(" S P=$E(P,2 ,15),P=$TR (P,")","-" ) | |
123 | I P?.N1" ".N 1" ".N S P =$TR(P," " ,"-") | |
124 | Q $S($E(P)'? 1N:P,1:P_T ) | |
125 | ACTIVE(I,D ) ;(psIen, Date 1 yea r ago);Che ck that pr escription dates are within th e past yea r | |
126 | N XD,PIE N,PP0,PPST A | |
127 | S XD=999 9999 | |
128 | I '$D(^P S(55,I,"P" ,0)) Q 0 ;No pre scription profiles | |
129 | PS S XD=$O( ^PS(55,I," P","A",XD) ,-1),PIEN= 0 I XD'>0! (XD<D) Q 0 ;No act ive profil es found | |
130 | PSRX S PIEN=$ O(^PS(55,I ,"P","A",X D,PIEN)) G PS:PIEN'> 0 | |
131 | G PSRX:' $D(^PSRX(P IEN,2),PP0 )!'$D(^PSR X(PIEN,"ST A"),PPSTA) ;No pha rma or sta tus node | |
132 | G PSRX:$ P(PP0,U)<D !PPSTA ;Lo gin date o lder than 1 year ago or status 'active | |
133 | Q 1 ;Profil e active | |
134 | ; | |
135 | AAREND ;Sp in off out put: | |
136 | I 'QED G AAR IO | |
137 | S %ZIS="Q",I OP="Q;"_CH FIO D ^%ZI S K ZTIO | |
138 | S ZTRTN="AAR IO^CHMMBM1 P",ZTDESC= "Allergy A ssessment" ,ZTDTH=$H | |
139 | S PAR=$$VPAC K,(ZTSAVE( "G("),ZTSA VE("PAR"), ZTSAVE("CH FIO"),ZTSA VE("^TMP($ J,"))="" | |
140 | D ^%ZTLOAD | |
141 | Q | |
142 | ; | |
143 | AARIO ;Put accumulat ed data to printer o r file: | |
144 | D:'$ D(QED) VSE T(PAR) | |
145 | IF T YPE="E" { | |
146 | ;DE V012893-08 YJK Mar 2 014 | |
147 | ;S XFILE=" HACFS3"" DNS decnet HAC dec741!"": :D:[Fs3big .MBMCMOP]" | |
148 | ;S XFILE=XFIL E_IOFILE | |
149 | ;O XFILE:"NWS " | |
150 | ;D INIT(1),HE ADER(1),DE TAIL C XFI LE | |
151 | N FOLDER,C NTR | |
152 | S FILE=IOF ILE_".TXT" ,FOLDER="" | |
153 | S IOF="#,* 27,*91,*50 ,*74,*27,* 91,*72" | |
154 | X ^%ZOSF(" UCI") S UC I=$P(Y,"," ,1) | |
155 | I UCI="HAC " S FOLDER ="HAC_HFS$ :[SCR.TEMP _FILES]" | |
156 | I UCI'="HA C" S FOLDE R="HAC_HFS $:[DSMMANA G.CHAMPVA] " | |
157 | S FILE=FOL DER_FILE | |
158 | S POP=0,CN TR=0 | |
159 | F S CNTR= CNTR+1 Q:( CNTR>5)!PO P D | |
160 | .S POP=$$O PENFIWR^CH TFLIB9(.FI LE,"FILE") | |
161 | .Q | |
162 | Q:'POP | |
163 | D I NIT(1),HEA DER(1),DET AIL D CLOS EF^CHTFLIB 9(FILE,"FI LE") | |
164 | D FTPFILE^ CHTFLIB9(F ILE," DNS fs3. DNS ","/FS3BIG /MBMCMOP", "PUT") } | |
165 | ELSE{ | |
166 | D INIT(0), HEADER(0,1 ),DETAIL | |
167 | W !!,"Tota l ",$J(TOT AL,5),?76, "End of Re port ;s&" } | |
168 | K ^ TMP($J,"AA R") | |
169 | Q | |
170 | ; | |
171 | DETAIL ;Pr int or exp ort bene: | |
172 | S ( STATE,PNAM E)="",(PFN ,TOTAL)=0 | |
173 | DS S S TATE=$O(^T MP($J,"AAR ",STATE)) Q:STATE="" | |
174 | DN S P NAME=$O(^T MP($J,"AAR ",STATE,PN AME)) G DS :PNAME="" | |
175 | DP S P FN=$O(^TMP ($J,"AAR", STATE,PNAM E,PFN)) G DN:PFN'>0 | |
176 | S X =^TMP($J," AAR",STATE ,PNAME,PFN ) | |
177 | D O UTPUT(X,TY PE) | |
178 | G D P | |
179 | ; | |
180 | HC(L) D:$Y +L>$S(CHUC I="HAC":59 ,1:58) HEA DER(0,1) Q 1 ; | |
181 | OUTPUT(X,T ) ;(Xrec, Type);Put a row out to printer or file: | |
182 | IF T="E" { S X=$TR (X,U,TAB) | |
183 | U XFILE W X,! } | |
184 | ELSE { | |
185 | S PSSN=$ P(X,U,4) | |
186 | S PAD =$E($P(X,U ,6)_", "_$ P(X,U,7)_" , "_$P(X,U ,8),1,56) | |
187 | S CSZ =$P(X,U,9) _", "_$P(X ,U,10)_" "_$P(X,U, 11) | |
188 | W:$$H C(2) !,$P( X,U),?5,$P (X,U,2),?1 0,$P(X,U,3 ),?43,PSSN ,?57,$P(X, U,5),?76,P AD | |
189 | W:$I( TOTAL) !,? 76,CSZ } | |
190 | Q | |
191 | ; | |
192 | HEADER(EF, CPF) ;Prin t or expor t header ( EF=Export Flag, CPF= Column tit le Print F lag): | |
193 | IF EF { U XFILE W TAB,TAB ,"ALLERGY ASSESSMENT REPORT",T AB,DATE,TA B,TIME,TAB | |
194 | W "**: NO CHAMPVA MATCH",!, HDR,! } | |
195 | ELSE { | |
196 | I PG> 1 W !,?10, "** denote s patients with SSNs not match ing a CHAM PVA benefi ciary." | |
197 | W @IO F,DUZ,?TT, TITLE,?123 ,"Page: ", $J(PG,3),! ,DATE,?ST, SUB | |
198 | W !,T IME,?PT,PA RAM,! | |
199 | D: CPF COLUMN S PG=PG+1 } | |
200 | Q | |
201 | ; | |
202 | INIT(EF) ; Set up pri nt or expo rt header (EF=Export Flag): | |
203 | S DATE=$$FI X($$FMTE^D ILIBF(TODA Y,6)),TIME =$$HTIM^AC KQUTL($H,0 ) | |
204 | I F EF { | |
205 | S HDR="" | |
206 | F I=1:1 :11 S HDR= HDR_$P($P( $T(FHDR)," ;",2),U,I) _$S(I'=12: TAB,1:"") } | |
207 | E LSE { | |
208 | S TITLE="D EPARTMENT OF VETERAN S AFFAIRS" ,TT=66-($L (TITLE)\2) | |
209 | IF STYL E["K" { S SUB="NO KN OWN ALLERG Y" } | |
210 | ELSE { S SUB="NO AL LERGY ASSE SSMENT" } | |
211 | S PARAM ="(PHONE # Type: [R] esidence, [W]ork, [C ]ellular, [B]enefici ary)" | |
212 | S SUB=" MbM "_SUB_ " REPORT ( " | |
213 | S SUB=S UB_$S(ALL= "A":"ALL S TATES",1:$ P(^DIC(5,$ P(STATE,U, 2),0),U))_ ")" | |
214 | S ST=66 -($L(SUB)\ 2),PG=1,PT =66-($L(PA RAM)\2) } | |
215 | Q | |
216 | FHDR ;NAA^ NKA^PATIEN T NAME^SSN ^PHONE # [ Type]^ADDR ESS 1^ADDR 2^A 3^CIT Y^STATE^ZI P; | |
217 | ; | |
218 | FIX(D) Q $ E(D,1,2)_" /"_$E(D,4, 5)_"/"_$E( D,7,10) ;< Replace "- " with "/" in (D)ate | |
219 | ; | |
220 | COLUMN ;Pr int column titles | |
221 | W ! ,"NAA",?5, "NKA",?10, "PATIENT N AME",?43," SSN",?57 | |
222 | W " PHONE # [T ype]",?76, "ADDRESSES / CITY, S TATE, ZIP" | |
223 | W ! ,"--- --- ",?10,"--- ---------- ---------- -------",? 43,"------ -----" | |
224 | W ? 57,"------ ---------- " | |
225 | W ? 76,"------ ---------- ---------- ---------- ---------- ---------- " | |
226 | Q | |
227 | ; | |
228 | ;Ru n time par ameters (c riteria): | |
229 | AorS() ;So licit whet her to lis t All or p atients of a particu lar state: | |
230 | K D IR S DIR(0 )="SAB^A:A ll states; S:Selected state" | |
231 | S D IR("A")=" (A)ll or a (S)elec ted state: ",DIR("B" )="A" | |
232 | S D IR("PRE")= "I X="""" S X=""A"" W X" | |
233 | S D IR("?")="" "A"" lists patients from all s tates, ""S """ | |
234 | S D IR("?")=DI R("?")_" o nly lists patients f rom a stat e to be en tered." | |
235 | D ^ DIR K DIR Q:"^^@"[X "^" | |
236 | Q Y | |
237 | ; | |
238 | State() ;S olicit whi ch state f rom which to list pa tients: | |
239 | ;K DIC S DIC =741002.83 ,DIC(0)="A EQMN" | |
240 | K DIC S DIC= 5,DIC(0)=" AEQMN" | |
241 | S DIC("A")=" Select sta te from wh ich to lis t patients : " | |
242 | S DIC("S")=" I $D(^CHMD IC(741002. 83,""B"",Y ))" | |
243 | D ^DIC K DIC | |
244 | Q: "^^@"[X "^ " | |
245 | Q $P(^DIC(5, $P(Y,U),0) ,U,2)_U_$P (Y,U) | |
246 | PorE() ;So licit outp ut destina tion (prin t or expor t): | |
247 | K D IR S DIR(0 )="SAB^P:P rint to se lected dev ice;E:Expo rt to deli mited text file" | |
248 | S D IR("A")=" ( P)rint or (E)xport t he output: ",DIR("B" )="E" | |
249 | S D IR("PRE")= "I X="""" S X=""E"" W X" | |
250 | S D IR("?")="" "P"" uses a WIDE pri nter, ""E" " creates a .TXT fil e." | |
251 | D ^ DIR K DIR Q:"^^@"[X "^" | |
252 | Q Y | |
253 | ; | |
254 | NAAorNKA() ;Solicit hardcopy r eport styl e (No Asse ssment or No Allergy ): | |
255 | K D IR S DIR(0 )="SAB^A:N AA - No Al lergy Asse ssment;" | |
256 | S D IR(0)=DIR( 0)_"K:NKA - No Known Allergy" | |
257 | S D IR("A")=" No (A)ss essment or (K)nown A llergy Rep ort?: ",DI R("B")="A" | |
258 | S D IR("PRE")= "I X="""" S X=""A"" W X" | |
259 | S D IR("?")="" "A"" print s benefici aries with out an ass essment" | |
260 | S D IR("?")=DI R("?")_" a nd ""K"" b eneficiari es with an assessmen t but no k nown aller gies." | |
261 | D ^ DIR K DIR Q:"^^@"[X "^" | |
262 | Q Y | |
263 | ; | |
264 | DChar() ;S olicit fie ld delimit er: | |
265 | K DIR S DIR( 0)="FAU^" | |
266 | S DIR("A")=" Fiel d delimite r for file : ",DIR("B ")="<Tab>" | |
267 | S DIR("PRE") ="I X="""" S X=""<Ta b>"" W X" | |
268 | S DIR("?")=" Enter a ch aracter to placed be tween fiel ds in the output dat a file." | |
269 | D ^DIR K DIR Q:"@"[X " @" | |
270 | Q Y | |
271 | ; |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.