82. EPMO Open Source Coordination Office Redaction File Detail Report

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.

82.1 Files compared

# 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

82.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 1 558
Changed 0 0
Inserted 1 1
Removed 0 0

82.3 Comparison options

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

82.4 Active regular expressions

No regular expressions were active.

82.5 Comparison detail

  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