Produced by Araxis Merge on 11/9/2018 12:33:51 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 | CHMACVE1.m | Mon Nov 5 16:39:56 2018 UTC |
2 | CPEE_Build9_Sprint27.zip\HAC_CPE_CH | CHMACVE1.m | Fri Nov 9 01:36:03 2018 UTC |
Description | Between Files 1 and 2 |
|
---|---|---|
Text Blocks | Lines | |
Unchanged | 1 | 558 |
Changed | 0 | 0 |
Inserted | 1 | 1 |
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 | CHMACVE1 ; HAC/CEP_JA H - Afford ability of Care Act related ro utines; 04 JUNE 2013 | |||||
2 | ;;1.3;CHA MPVA;**179 33**;JUN 4 ,2013;Buil d 12 | |||||
3 | ;CHMACV* routines g enerate XM L-formatte d response via RPC c alls | |||||
4 | ; (throug h VistALin k) in supp ort of the Affordabi lity of Ca re | |||||
5 | ; Act man dates and eligibilit y / benefi ciary data collectio n | |||||
6 | ; JOHN HE IGES & CHA D PETERSON | |||||
7 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;; | |||||
8 | ;;DO NOT EDIT ANY P ART OF ANY CHMAC* RO UTINES | |||||
9 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;; | |||||
10 | ; CHMACVE 1: CHAMPVA ACA VISTA LINK ELIGI BILITY SER VICE ROUTI NES | |||||
11 | ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;; | |||||
12 | GETELIG(RE TURN,IDSTR ING,CHTID) ;; MAIN ENTRY POINT | |||||
13 | N MYPA RAMS,MYSVC NAME,CHTS, CHCUR,X,CH TSODBC,%I, %H,%,CHCUR FM,CHRESPO NSE | |||||
14 | N ERRO RS,CHERRS | |||||
15 | ; | |||||
16 | ; INPU T: | |||||
17 | ; ID STRING (re quired) | |||||
18 | ; for mat: "1234 -1^PI^741^ USVHA^A" | |||||
19 | ; where 123 4 is the I EN in CHAM PVA BENE F ILE | |||||
20 | ; 1 is the I EN in #100 BENE mult iple. | |||||
21 | ; P I is ID Ty pe: | |||||
22 | ; "NI" ;N ational un ique indiv idual iden tifier | |||||
23 | ; "PI" ;P atient int ernal iden tifier | |||||
24 | ; 74 1 is assig ning stati on | |||||
25 | ; USVH A is assig ning autho rity | |||||
26 | ; A is ignor ed | |||||
27 | ; | |||||
28 | ; IDSTR ING (optio nal for tr acking) | |||||
29 | ; Tra nsaction I D: should be a unive rsally uni que identi fier (UUID ) | |||||
30 | ; wit h characte r form 8-4 -4-4-12. T hat is 36 characters (32 chars plus | |||||
31 | ; the 4 hyphens ): | |||||
32 | ; example: 756d357d-7 8fc-4d90-9 17a-3041aa 0838e7 | |||||
33 | ; 8 - 4 - 4 - 4 - 12 | |||||
34 | ; | |||||
35 | ; OUTP UT | |||||
36 | ; RE TURN: XML format glo bal array with eligi bility inf ormation | |||||
37 | ; | |||||
38 | ;Parse the input string | |||||
39 | S MYPA RAMS=$$IDS TOPL^CHMAC VU2(IDSTRI NG) | |||||
40 | D NOW^ %DTC | |||||
41 | S (CHC UR,CHCURFM )=% | |||||
42 | ; | |||||
43 | ;Get t he eligibi lity data and format into an X ML respons e | |||||
44 | D XMLE LIG(.CHRES PONSE,IDST RING,CHTID ) | |||||
45 | ;;** S MYSVCNAM E=$P($G(CH RESPONSE(0 )),"^",1) ;;REMOVED - ADDED L INE BELOW | |||||
46 | S MYSV CNAME="Get Eligibilit y" | |||||
47 | ; | |||||
48 | ;File transactio n--all inp uts, outpu t and time stamp | |||||
49 | S CHER RS=0 ;; DEFAULT TO NO ERRS | |||||
50 | I CHTI D="" S CHT ID="eeeeee ee-eeee-ee ee-eeee-ee eeeeeeeeee ",CHERRS=1 ;;to den ote error trans id | |||||
51 | I $G(E RRORS(0))> 0 S CHERRS =1 | |||||
52 | D FILE TX^CHMACVU 1(CHTID,CH CURFM,MYSV CNAME,MYPA RAMS,.CHRE SPONSE,CHE RRS) | |||||
53 | ; | |||||
54 | ;Creat e & clean RETURN Val ue. | |||||
55 | S RETU RN=$NA(^TM P("CH_ACA_ ELIG_RESPO NSE",$J)) | |||||
56 | K @RETURN | |||||
57 | ; | |||||
58 | ;Move local symb ol array R ETURN to ^ TMP for th e Broker t o process | |||||
59 | ; | |||||
60 | M @RETURN =CHRESPONS E | |||||
61 | Q | |||||
62 | XMLELIG(OU T,IDSTRING ,CHTID) ;F ORMULATE X ML RESPONS E | |||||
63 | ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ; | |||||
64 | ;; RET URN(BYREF) OUT; INPU TS CHDFN(A SPONSOR I D), CHBFN( A BENEFICI ARY ID), | |||||
65 | ;; CHT ID(A TRANS ACTION ID) | |||||
66 | ;; OUT (1..n) = X ML FORMATT ED RETURN | |||||
67 | ;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ; | |||||
68 | N MYSV CNAME,U,CN SXMLZN,CNS XMLNS,CNSX MLN2,CNSVS TAG,CNSVTA G,CNSPSTAG ,CNSPTAG,C NSPBTAG,CN SPETAG | |||||
69 | N CNSB PTAG,CNSCR TAG,CNSCST AG,CNSCDTA G,CNSDSTAG ,LNCNTR,BP COUNT,ALEV EL,BPED,BP SD,I,J,CHO UT | |||||
70 | N MYPA RAMS,CHTS, ALEVEL,CHB FN,CHDFN,C NSELTAG,MS GOKAY,ERRO UT,CNSTAGN S,CNSCUTAG ,CNSDUTAG | |||||
71 | N CNSI DAUT,CNSID FAC,CNSIDS TT,CNSIDTX T,CNSIDTYP ,CNSSTCOD, VALPCD,VAL PDX,VALCSC ,VALCSD,VA LSRC,VALSR D | |||||
72 | ;N ERR ORS | |||||
73 | S CNSX MLZN="<?xm l version= ""1.0"" en coding=""U TF-8""?>" ;; CONSTANTS: ZERO NODE | |||||
74 | S CNSX MLNS="tns: Eligibilit yResponse xsi:schema Location=" "http://vi ers.va.gov /schema/CP E/Response /v1/CPERes ponse.xsd" "" | |||||
75 | S CNSX MLNS=CNSXM LNS_" xmln s:el=""htt p://viers. va.gov/sch ema/Benefi ciaryEligi bilityServ ice/Eligib ility/v1"" " | |||||
76 | S CNSX MLNS=CNSXM LNS_" xmln s:tns=""ht tp://viers .va.gov/sc hema/CPE/R esponse/v1 """ | |||||
77 | S CNSX MLNS=CNSXM LNS_" xmln s:xsi=""ht tp://www.w 3.org/2001 /XMLSchema -instance" "" | |||||
78 | S CNST AGNS="el:" ;; change to "tns:" if req'd | |||||
79 | S CNSX MLN2="tns: Eligibilit yResponse" | |||||
80 | S CNSS TCOD="tns: Code" | |||||
81 | S CNSE LTAG="tns: Eligibilit y" | |||||
82 | S CNSV STAG=CNSTA GNS_"VAHIs " | |||||
83 | S CNSV TAG=CNSTAG NS_"VAHI" | |||||
84 | S CNSP STAG=CNSTA GNS_"Eligi bilityPeri ods" | |||||
85 | S CNSP TAG=CNSTAG NS_"Eligib ilityPerio d" | |||||
86 | S CNSP BTAG=CNSTA GNS_"Begin Date" | |||||
87 | S CNSP ETAG=CNSTA GNS_"EndDa te" | |||||
88 | S CNSB PTAG=CNSTA GNS_"Benef itProgram" | |||||
89 | S CNSC RTAG=CNSTA GNS_"Curre ntStatusRe ason" | |||||
90 | S CNSC STAG=CNSTA GNS_"Curre ntStatus" | |||||
91 | S CNSC DTAG=CNSTA GNS_"code" ;; for Curren tStatusRea son and Cu rrent Stat us | |||||
92 | S CNSD STAG=CNSTA GNS_"descr iption" ;; lower case in XSD | |||||
93 | S CNSC UTAG=CNSTA GNS_"Code" ;; for Benefi tProgram | |||||
94 | S CNSD UTAG=CNSTA GNS_"Descr iption" ;; Ucase in X SD | |||||
95 | S U="^ " | |||||
96 | ;; PIC K APART ID STRING FO RMATED AS DFN-BFN^ID TYPE^ASSIG NING FACIL ITY^AS.AUT HORITY^IDS TATUS" | |||||
97 | S CNSI DTXT=$P(ID STRING,"^" ,1) ;;ID TEXT | |||||
98 | S CNSI DTYP=$P(ID STRING,"^" ,2) ;;ID TYPE | |||||
99 | S CNSI DFAC=$P(ID STRING,"^" ,3) ;;ID ASSI GNING FACI LITY | |||||
100 | S CNSI DAUT=$P(ID STRING,"^" ,4) ;;ID ASSI GNING AUTH ORITY | |||||
101 | S CNSI DSTT=$P(ID STRING,"^" ,5) ;;ID STAT US <NOT US ED> | |||||
102 | S CHDF N=$P($P(ID STRING,"^" ,1),"-",1) | |||||
103 | S CHBF N=$P($P(ID STRING,"^" ,1),"-",2) | |||||
104 | ;;END PIECING | |||||
105 | ;;**S MYSVCNAME= "GetEligib ility" ;; REMOVED -A DDED HIGHE R UP | |||||
106 | S ALEV EL=0,ERROR S="",MSGOK AY=1 ;;INIT | |||||
107 | S LNCN TR=1 ;;INIT | |||||
108 | ;;DO C HECK | |||||
109 | D CHKI NPUT^CHMAC VU1(.ERROR S,IDSTRING ,CHTID) | |||||
110 | I $G(E RRORS(0))> 0 S MSGOKA Y=0 ;;THERE W ERE ERRORS | |||||
111 | I MSGO KAY D ;; ON BFN/DFN | |||||
112 | . D GE TCUREL(.CH OUT,CHDFN, CHBFN,CHTI D) | |||||
113 | . K OU T ;;BL OW OUT OLD STUFF | |||||
114 | . S OU T="" ;;JU ST IN CASE | |||||
115 | . S BP COUNT=$P(@ CHOUT@(0), "^",1) ;;BE NEFIT PROG RAM COUNT | |||||
116 | . ;;I +BPCOUNT>0 D ;;TH IS IS WHER E WE BOMB IF NO POE | |||||
117 | . I +B PCOUNT>=0 D ;;C EP-CHANGED TO >=0 | |||||
118 | .. S OUT(LNCNTR )=CNSXMLZN ,LNCNTR=LN CNTR+1 | |||||
119 | .. S OUT(LNCNTR )=$$XMLO^C HMACVU1(CN SXMLNS,.AL EVEL),LNCN TR=LNCNTR+ 1 ;;ELIGI BILITYRESP ONSE TAG | |||||
120 | .. S OUT(LNCNTR )=$$XMLDAT A^CHMACVU1 (CNSSTCOD, "SUCCESS", .ALEVEL),L NCNTR=LNCN TR+1 ;;ST ATUS TAG | |||||
121 | .. S OUT(LNCNTR )=$$XMLO^C HMACVU1(CN SELTAG,.AL EVEL),LNCN TR=LNCNTR+ 1 ;;ELIGI BILITY TAG | |||||
122 | .. S OUT(LNCNTR )=$$XMLO^C HMACVU1(CN SVSTAG,.AL EVEL),LNCN TR=LNCNTR+ 1 ;;OPEN VAHIS TAG | |||||
123 | .. F I=1:1:BPCO UNT D | |||||
124 | ... S VALPCD=$ P(@CHOUT@( I,0),"^",1 ) ;;PROGR AM CODE | |||||
125 | ... S VALPDX=$ P(@CHOUT@( I,0),"^",2 ) ;;PROGR AM DX | |||||
126 | ... S VALCSC=$ P(@CHOUT@( I,0),"^",3 ) ;;CURRE NT STATUS CODE | |||||
127 | ... S VALCSD=$ P(@CHOUT@( I,0),"^",4 ) ;;CURRE NT STATUS DX | |||||
128 | ... S VALSRC=$ P(@CHOUT@( I,0),"^",5 ) ;;PROGR AM STATUS REASON COD E | |||||
129 | ... S VALSRD=$ P(@CHOUT@( I,0),"^",6 ) ;;PROGR AM STATUS REASON DX | |||||
130 | ... S OUT(LNCN TR)=$$XMLO ^CHMACVU1( CNSVTAG,.A LEVEL),LNC NTR=LNCNTR +1 ;;OPEN VAHI TAG | |||||
131 | ... S OUT(LNCN TR)=$$XMLO ^CHMACVU1( CNSCSTAG,. ALEVEL),LN CNTR=LNCNT R+1 ;;OPEN CURRENTST ATUS TAG | |||||
132 | ... S OUT(LNCN TR)=$$XMLD ATA^CHMACV U1(CNSCDTA G,VALCSC,. ALEVEL),LN CNTR=LNCNT R+1 | |||||
133 | ... I VALCSD'= "" S OUT(L NCNTR)=$$X MLDATA^CHM ACVU1(CNSD STAG,VALCS D,.ALEVEL) ,LNCNTR=LN CNTR+1 | |||||
134 | ... S OUT(LNCN TR)=$$XMLC ^CHMACVU1( CNSCSTAG,. ALEVEL),LN CNTR=LNCNT R+1 ;;CLOS E THE CURR ENTSTATUS TAG | |||||
135 | ... S OUT(LNCN TR)=$$XMLO ^CHMACVU1( CNSPSTAG,. ALEVEL),LN CNTR=LNCNT R+1 ;;OPEN ELIGIBILI TYPERIODS TAG | |||||
136 | ... F J=1:1:$G (@CHOUT@(I ,1,0)) D | |||||
137 | .... S BPSD=$ P(@CHOUT@( I,1,J),"^" ,1) ;;TRAN SLATE TO O DBC FORMAT | |||||
138 | .... S BPED=$ P(@CHOUT@( I,1,J),"^" ,2) ;; (WI TH "-" INS TEAD OF "/ " | |||||
139 | .... I BPSD'= "" S BPSD= $TR(BPSD," /","-") | |||||
140 | .... I BPED'= "" S BPED= $TR(BPED," /","-") | |||||
141 | .... S OUT(LN CNTR)=$$XM LO^CHMACVU 1(CNSPTAG, .ALEVEL),L NCNTR=LNCN TR+1 ;;OPE N ELIGIBIL ITYPERIOD TAG | |||||
142 | .... S OUT(LN CNTR)=$$XM LDATA^CHMA CVU1(CNSPB TAG,BPSD,. ALEVEL),LN CNTR=LNCNT R+1 | |||||
143 | .... I BPED'= "" S OUT(L NCNTR)=$$X MLDATA^CHM ACVU1(CNSP ETAG,BPED, .ALEVEL),L NCNTR=LNCN TR+1 | |||||
144 | .... S OUT(LN CNTR)=$$XM LC^CHMACVU 1(CNSPTAG, .ALEVEL),L NCNTR=LNCN TR+1 ;;CLO SE ELIGIBI LITYPERIOD TAG | |||||
145 | .... Q | |||||
146 | ... S OUT(LNCN TR)=$$XMLC ^CHMACVU1( CNSPSTAG,. ALEVEL),LN CNTR=LNCNT R+1 ;;CLOS E ELIGIBIL ITYPERIODS TAG | |||||
147 | ... S OUT(LNCN TR)=$$XMLO ^CHMACVU1( CNSBPTAG,. ALEVEL),LN CNTR=LNCNT R+1 ;;OPEN BENEFITPR OGRAM TAG | |||||
148 | ... S OUT(LNCN TR)=$$XMLD ATA^CHMACV U1(CNSCUTA G,VALPCD,. ALEVEL),LN CNTR=LNCNT R+1 | |||||
149 | ... I VALPDX'= "" S OUT(L NCNTR)=$$X MLDATA^CHM ACVU1(CNSD UTAG,VALPD X,.ALEVEL) ,LNCNTR=LN CNTR+1 | |||||
150 | ... S OUT(LNCN TR)=$$XMLC ^CHMACVU1( CNSBPTAG,. ALEVEL),LN CNTR=LNCNT R+1 ;;CLOS E THE BENE FITPROGRAM TAG | |||||
151 | ... S OUT(LNCN TR)=$$XMLO ^CHMACVU1( CNSCRTAG,. ALEVEL),LN CNTR=LNCNT R+1 ;;OPEN STATUSREA SON TAG | |||||
152 | ... S OUT(LNCN TR)=$$XMLD ATA^CHMACV U1(CNSCDTA G,VALSRC,. ALEVEL),LN CNTR=LNCNT R+1 | |||||
153 | ... I VALSRD'= "" S OUT(L NCNTR)=$$X MLDATA^CHM ACVU1(CNSD STAG,VALSR D,.ALEVEL) ,LNCNTR=LN CNTR+1 | |||||
154 | ... S OUT(LNCN TR)=$$XMLC ^CHMACVU1( CNSCRTAG,. ALEVEL),LN CNTR=LNCNT R+1 ;;CLOS E THE STAT USREASON T AG | |||||
155 | ... S OUT(LNCN TR)=$$XMLC ^CHMACVU1( CNSVTAG,.A LEVEL),LNC NTR=LNCNTR +1 ;;CLOS E VAHI TAG | |||||
156 | ... Q | |||||
157 | .. S OUT(LNCNTR )=$$XMLC^C HMACVU1(CN SVSTAG,.AL EVEL),LNCN TR=LNCNTR+ 1 ;;CLOSE VAHIS TAG | |||||
158 | .. S OUT(LNCNTR )=$$XMLC^C HMACVU1(CN SELTAG,.AL EVEL),LNCN TR=LNCNTR+ 1 ;;CLOSE ELIGIBILI TY TAG | |||||
159 | .. S OUT(LNCNTR )=$$XMLC^C HMACVU1(CN SXMLN2,.AL EVEL),LNCN TR=LNCNTR ;;CLOSE ELIGIBILI TYRESPONSE TAG | |||||
160 | .. Q | |||||
161 | . ;;** S OUT(0)=M YSVCNAME_U _LNCNTR_U_ CHDFN_U_CH BFN ;;REM OVED | |||||
162 | . ;;** S OUT=IDST RING ;;REM OVED | |||||
163 | . Q | |||||
164 | I 'MSG OKAY D ;;MESSAGE HAS ERROR S - | |||||
165 | . S OU T(LNCNTR)= CNSXMLZN,L NCNTR=LNCN TR+1 ;;BUILD E RROR XML | |||||
166 | . S OU T(LNCNTR)= $$XMLO^CHM ACVU1(CNSX MLNS,.ALEV EL),LNCNTR =LNCNTR+1 ;;NAMESPA CE TAG | |||||
167 | . S OU T(LNCNTR)= $$XMLDATA^ CHMACVU1(C NSSTCOD,"E RROR",.ALE VEL),LNCNT R=LNCNTR+1 ;;STATUS :ERROR | |||||
168 | . D ER RXML^CHMAC VU1(.ERROU T,.ERRORS) ;;LOOP ER RORS FROM ABOVE CALL | |||||
169 | . F I= 1:1:ERROUT (0) D ;;TO CHKI NPUT | |||||
170 | .. S O UT(LNCNTR) =ERROUT(I) ,LNCNTR=LN CNTR+1 | |||||
171 | .. Q | |||||
172 | . S OU T(LNCNTR)= $$XMLC^CHM ACVU1(CNSX MLN2,.ALEV EL),LNCNTR =LNCNTR ;;CLOSE M AIN ER TAG | |||||
173 | . Q | |||||
174 | ;;**S OUT(0)=MYS VCNAME_U_L NCNTR_U_CH DFN_U_CHBF N,OUT=IDST RING ;;RE MOVED | |||||
175 | Q | |||||
176 | GETCUREL(C HARY,CHDFN ,CHBFN,CHT ID) ; returns da ta necessa ry for res ponse | |||||
177 | ; to t he ACA get Eligibilit y Periods, form can also be us ed to get data | |||||
178 | ; in p reparation of XML fo rmatting | |||||
179 | ; | |||||
180 | ;TODO: USE TRANS ACTION ID PARAMETER TO LOG THA T THE RPC WAS USED?? ?? | |||||
181 | ; | |||||
182 | ; get beneficiar y's curren t eligibil ity status | |||||
183 | ; CHAM PVA BENEFI CIARY FILE (#554801) Stored in ^AHCHVA( | |||||
184 | ; | |||||
185 | ; ==== =====Input ========== ====== | |||||
186 | ; CHDF N : sponso r identifi er | |||||
187 | ; CHBF N : benefi ciary iden tifier | |||||
188 | ; CHTI D : Transa ction ID u sed for Vi stA loggin g | |||||
189 | ; | |||||
190 | ; | |||||
191 | ; ==== =====Outpu t========= ====== | |||||
192 | ; | |||||
193 | ; --- CHARY - RE TURN GLOBA L ARRAY by reference | |||||
194 | ; ^TMP ("CH_ACA_E LIG_RESPON SE",$J,pro gram count ,0)= | |||||
195 | ; " Pr ogram 1 co de ^ progr am 1 dx ^ eligibilit y status c ode ^ | |||||
196 | ; elig ibility st atus code descriptio n ^ status reason co de ^ | |||||
197 | ; stat us reason code descr iption " | |||||
198 | ; | |||||
199 | ; ^TMP ("CH_ACA_E LIG_RESPON SE",$J,pgc ount,1,0)= periods o f eligibil ity | |||||
200 | ; ^TMP ("CH_ACA_E LIG_RESPON SE",$J,pgc ount,1,1.. n,0)= star t date ^ e nd date | |||||
201 | ; | |||||
202 | ; get return arr ay ready | |||||
203 | ; | |||||
204 | S CHAR Y=$NA(^TMP ("CH_ACA_E LIG_RESPON SE",$J)) | |||||
205 | K @CHA RY | |||||
206 | ; | |||||
207 | S U="^ " | |||||
208 | N ELIG STAT,VETFO UND,BENFOU ND,PGMCOUN T,ELREASON | |||||
209 | S PGMC OUNT=0 | |||||
210 | S CHAR Y=$NA(^TMP ("CH_ACA_E LIG_RESPON SE",$J)) | |||||
211 | K @CHA RY | |||||
212 | S VETF OUND=$$FND SPONS(CHDF N) | |||||
213 | I '(+V ETFOUND) S @CHARY@(0 )=VETFOUND _U_CHTID_U _CHDFN_U_C HBFN Q | |||||
214 | S BENF OUND=$$FND BENE(CHDFN ,CHBFN) | |||||
215 | I '(+B ENFOUND) S @CHARY@(0 )=BENFOUND _U_CHTID_U _CHDFN_U_C HBFN Q | |||||
216 | S ELIG STAT=$$GET STATC^CHMA CVU1(CHDFN ,CHBFN) | |||||
217 | S ELRE ASON=$$GET STATR^CHMA CVU1(CHDFN ,CHBFN) | |||||
218 | ; | |||||
219 | ;If an y status u nder CHAMP VA program set statu s and load periods o f | |||||
220 | ;eligi blity if t here are a ny. updat e program counter. | |||||
221 | ; | |||||
222 | ;I $$C HAMPVA^CHM ACVU1(CHDF N,CHBFN) D | |||||
223 | ;bette r check fo r CHAMPVA status | |||||
224 | I ELIG STAT'="" D | |||||
225 | . S P GMCOUNT=PG MCOUNT+1 | |||||
226 | . S @ CHARY@(PGM COUNT,0)=" CHAMPVA^CH AMPVA"_U_E LIGSTAT_U_ ELREASON | |||||
227 | .; | |||||
228 | .; if we have a t least on e period t hen load a rray with them | |||||
229 | . I $ $CHAMPVA^C HMACVU1(CH DFN,CHBFN) D | |||||
230 | .. D PERIODS (.CHARY,CH DFN,CHBFN, PGMCOUNT) | |||||
231 | . E D | |||||
232 | ..; otherwise set the p eriod coun t to zero. | |||||
233 | .. S @CHARY@ (PGMCOUNT, 1,0)=0 | |||||
234 | ; | |||||
235 | ; if e ligibile u nder SPINA BIFADA pr ogram load award dat e and upda te program | |||||
236 | ; coun ter | |||||
237 | ; | |||||
238 | N SPIN A | |||||
239 | S SPIN A=0 | |||||
240 | S SPIN A=$$SPINAB IF^CHMACVU 1(CHDFN,CH BFN) | |||||
241 | I SPIN A D | |||||
242 | . S PG MCOUNT=PGM COUNT+1 | |||||
243 | . S @C HARY@(PGMC OUNT,0)="S B^Spina Bi fida"_U_EL IGSTAT_U_E LREASON | |||||
244 | . S @C HARY@(PGMC OUNT,1,0)= 1 | |||||
245 | . S @C HARY@(PGMC OUNT,1,1)= $P(SPINA,U ,2,3) | |||||
246 | ; | |||||
247 | ;updat e program counter | |||||
248 | S @CHA RY@(0)=PGM COUNT_U_CH DFN_U_CHBF N | |||||
249 | Q | |||||
250 | ; | |||||
251 | FNDSPONS(C HDFN) ;FIN D VETERAN/ SPONSOR BA SED ON CHD FN | |||||
252 | N FOUN D,DATA | |||||
253 | S FOUN D="0:VETER AN SPONSOR NOT FOUND ",DATA="" | |||||
254 | Q:+CHD FN'>0 FOUN D | |||||
255 | I $D(^ AHCHVA(+CH DFN)) S FO UND=1,DATA =$G(^AHCHV A(+CHDFN,0 )) | |||||
256 | Q FOUN D_U_DATA | |||||
257 | ;^AHCH VA(CHDFN,1 00,CHBFN,0 ) | |||||
258 | FNDBENE(CH DFN,CHBFN) ;FIND VET ERAN/SPONS OR BASED O N CHDFN | |||||
259 | N FOUN D,DATA | |||||
260 | S FOUN D="0:BENEF ICIARY NOT FOUND",DA TA="" | |||||
261 | Q:+CHD FN'>0!(+CH BFN'>0) FO UND | |||||
262 | I $D(^ AHCHVA(+CH DFN,100,CH BFN)) D | |||||
263 | . S FO UND=1 | |||||
264 | . S DA TA=$G(^AHC HVA(+CHDFN ,100,CHBFN ,0)) | |||||
265 | Q FOUN D_U_DATA | |||||
266 | ; | |||||
267 | PERIODS(CH ARY,CHDFN, CHBFN,PCOU NT) ;load periods of eligibili ty | |||||
268 | N PERI ODS,STARTD T,ENDDATE | |||||
269 | S PERI ODS=0 | |||||
270 | Q:$G(C HDFN)'>0!( $G(CHBFN)' >0) | |||||
271 | S (STA RTDT,ENDDA TE,PERIODS )=0 | |||||
272 | ;initi alize peri od count t o zero | |||||
273 | S @CHA RY@(PCOUNT ,1,0)=0 | |||||
274 | F S S TARTDT=$O( ^AHCHVA(CH DFN,100,CH BFN,109,ST ARTDT)) Q: STARTDT'>0 D | |||||
275 | . S EN DDATE=$O(^ AHCHVA(CHD FN,100,CHB FN,109,STA RTDT,0)) | |||||
276 | . S PE RIODS=PERI ODS+1 | |||||
277 | . S @C HARY@(PCOU NT,1,PERIO DS)=$$FMTE ^XLFDT(STA RTDT,"7DZ" )_U_$$FMTE ^XLFDT(END DATE,"7DZ" ) | |||||
278 | . S @C HARY@(PCOU NT,1,0)=PE RIODS | |||||
279 | Q | |||||
280 | TTT |
Araxis Merge (but not the data content of this report) is Copyright © 1993-2016 Araxis Ltd (www.araxis.com). All rights reserved.