261. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 11/9/2018 12:34:14 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.

261.1 Files compared

# Location File Last Modified
1 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMXWB21.m Mon Nov 5 16:42:20 2018 UTC
2 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMXWB21.m Fri Nov 9 03:37:05 2018 UTC

261.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 4 3346
Changed 3 10
Inserted 0 0
Removed 0 0

261.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

261.4 Active regular expressions

No regular expressions were active.

261.5 Comparison detail

  1   CHMXWB21         ;HAC /DLB;WEB 5 010 277 UN SOLICITED  STATUS/DRI VER PART 1 ;10/25/10
  2           ;; 1.0;CHAMPV A SYSTEM;* *003**;JUL Y 11,2011; Build 11
  3           ;;  5/15/13 J WS:HARRIS  - HAPE POR  DO#118-11 -D-1009, T O#118-1009 -0001
  4           ;; V1.0;
  5           ;; CALLED BY  ^CHMXG001  TO PERFORM  THE "ACK"  STATUS
  6           ;; CALLED BY  TASKMAN TO  PERFORM T HE "PENDIN G" AND "FI NAL" STATU S
  7           ;; CALLS ENTR Y POINTS T O CHMXWB22 ,CHMXWBUT
  8           ;H R-COB-Medi care-A/B-B egin-9372  (27-May-20 10)
  9           ;;
  10           ;;  10/18/201 1 ADDED TS TBLDCLM()  ENTRY POIN T TO VALID ATE THE RE JECT
  11           ;;              VALUES B EING REPOR TED IN THE  CSTAT FIL E
  12           ;;  10/20/201 1 MODIFIED  THE LINE( ) FUNCTION  TO FIX IN CORRECT RE JECT STATU S
  13           ;;                REPORT ING IN THE  CSTAT FIL E
  14           ;;  10/21/201 1 ADDED TH E SIX DATE  GATHERING  FUNCTIONS  TO SUPPOR T THE RULE  
  15           ;;                PROVID ED BY BUSI NESS GROUP  FOR I/P/D  CLAIMS
  16           ;;  10/21/201 1 ADDED TH E GETCLMTY P() FUNCTI ON TO DETE RMINE THE  I/P/D
  17           ;;              CLAIM TY PE FOR BOT H 4010 AND  5010 INCO MING CLAIM S
  18           ;;  10/24/201 1 CHANGED  THE DATERA NGE FUNCTI ON TO A EX ISTING DAT E FUNCTION
  19           ;;                IN THE  UTILITY R OUTINE: CH MXWBUT.INT
  20           ;;  10/25/201 1 CHANGED  THE RENDER ING PHYSIC IAN NPI RE TRIEVAL TO  GET THE
  21           ;;              DATA FRO M THE CHMX CLE(I,64)  TIN DATA F IELD.
  22           ;;  10/25/201 1 ADDED A  TEST FOR T HE "U" VAL UE RECEIVE D FROM EMD EON TO
  23           ;;              RETURN " " IF NOT A  "M" OR "F " (ONLY AC CEPTED VAL UES)
  24           ;;  10/26/201 1 REMOVED  ERROR MESS AGE OUTPUT  FOR ERROR  TRAP HAND LER 
  25           ;;  
  26           ;;  10/26/201 1 CHANGED  THE INSTIT UTIONAL AN D DENTAL S TART/END D ATES
  27           ;;              FOR CLAI M LEVEL RE PORTING TO  GET START  FROM ^CHM XCLE(I,1)
  28           ;;              ,FIELD 1  AND END T O ^CHMXCLE (I,1) FIEL D 2
  29           ;;  11/4/2011   CHANGED  THE DATE C HECK ROUTI NE GETCLMI () TO RETU RN THE
  30           ;;              CORRECT  DATE FOR T HE DESIRED  FLAG 
  31           ;;  05/15/201 3 HAPE POR  DO#118-11 -D-1009, T O#118-1009 -0001 - ad ded
  32           ;;              FINAL ST ATUS file  creation.
  33           ;;  02/05/201 4 MTN02028 6-01 - YJK : Reduce t he Pending  CSTAT Fil e Size for  140MB to  5 MB for T esting 
  34           ;;              ** THIS  CHANGE IS  ONLY FOR Q A.  THIS C HANGE IS T O BE REMOV ED WHEN GO ING LIVE * *
  35           ;;  02/10/201 4 SBB DEV0 20322  POR : Change t o the "E"  Reference  for RUNDAT
  36           ;;                  to ^ CHMPAY(I,1 0) piece 2 3 and M cr oss refere nce for FI LE RUN DAT E
  37           ;;             
  38           ;; 1.0 IS THE  INITIAL V ERSION (HI PAA Ready  LLC) 
  39           ;; 2.0 UPDATE S TO THE S TATUS REPO RT PER HIP AA II SPEC IFICATIONS .
  40           ;;   *** File names shou ld not be  hard coded  in files.  See ^CHMX 277 TRACKI NG
  41           ;;   GLOBAL F ILE for th e destinat ion direct ory/filena mes for th e 5010 sta tus
  42           ;;   files.
  43           Q
  44           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  45           ;  PRODUCTION  ENTRY POI NTS TO PRO CESS THE C URRENT STA TUS.         ;
  46           ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  47           ;; DEF016554  -- REPLACE  OPEN COMM AND WITH E XTRINSIC F UNCTION OP EN -- DRW  07/20/2015
  48   EPACK(CHMX I)    ; SE T UP THE F ILE/BATCH  INDEX (PRO VIDED BY C HMXG001)
  49               ;   CHMXI         I  INDEX INTO  ^CHMXCL()
  50               N COUNT,D IRFILE,GRP CNT,FILECN T,LSTTIME, HOLD,DATES TAMP,STVAL ,RUNTYPE
  51               N FMDATE, CHTPI,CHTP ARR,CNT
  52               N MAXCNT, EICNT,CHA, CHMEDCOB
  53               S FILECNT =0,RUNTYPE ="A",GRPCN T=1,EICNT= 0
  54               S CHMEDCO B=0  ; ASS UME NOT A  "COB" TRAD ING PARTNE R
  55               D INIT
  56               S CHA=$O( ^CHMXCLA(" B",CHMXI," ")) Q:CHA= ""
  57               S CHTPI=$ P($G(^CHMX CLA(CHA,1) ),"^",1) Q :CHTPI=""   ; GET CLA IM T/P FOR  FILE BEIN G CHECKED
  58               S CHTPI=$ O(^CHMXTP( "C",CHTPI, "")) Q:CHT PI="" D     ; GET "LO CAL" TP ID
  59               S IDX=$O( ^CHMX277(" B",CHTPI,0 ))
  60               S:$P(^CHM X277(IDX,0 ),"^",4)[" COB" CHMED COB=1       ; TRADING  PARTNER 1 1 = "COB"  EMDEON PAR TNER
  61               D GETCHCL EI(CHMXI,C HTPI)  ; R ETRIEVE ^C HMXCLE IND EX
  62               Q:^ZSC($J ,0)=0             ; N O RECORDS  FOUND, CRE ATE NO FIL E
  63               D CREATEF ILE
  64               D FMUPDAT E(CHTPI)          ; U PDATE TRAC KING GLOBA L VIA FILE MAN FUNCTI ON
  65               Q
  66               ;
  67   EPPENDTST        ;
  68               N TEST S  TEST=1
  69               D EPPEND
  70               Q
  71               ;
  72   EPPEND  ;
  73               N COUNT,D IRFILE,GRP CNT,SEQCNT ,LSTTIME,H OLD,DATEST AMP,STVAL, RUNTYPE,FM DATE,CHTPI ,CHTPARR
  74               N CHNODED EF,BREF,CH IJKVAL,DRD ATA,TRKDAT A,MAXCNT,C HMEDCOB,ID X        ;  FILEMAN U PDATE VARI ABLES
  75               N CHTO,CH FROM,TRKI, EICNT
  76               S RUNTYPE ="P",GRPCN T=1,EICNT= 0  ; INITI ALIZE FROM /TO INDICE S,STATUS T YPE
  77               D INIT
  78               S CHTPI=" A"
  79               F  S CHTP I=$O(^CHMX 277("B",CH TPI),-1) Q :CHTPI=""   D  ;TRADI NG PARTNER S FROM "B"  XREF
  80               .S CHMEDC OB=0                      ; ASSU ME NOT A " COB" TRADI NG PARTNER
  81               .S IDX=$O (^CHMX277( "B",CHTPI, 0))
  82               .S:$P(^CH MX277(IDX, 0),"^",4)[ "COB" CHME DCOB=1  ;  TRADING PA RTNER 11 =  "COB" EMD EON PARTNE R
  83               .K CHTPAR R
  84               .S (CHFRO M,CHTO,FIL ECNT)=0                     ; KI LL TRADING  PARTNER A RRAY 
  85               .S TRKI=0 ,TRKI=$O(^ CHMX277("B ",CHTPI,TR KI))  ; GE T TRACKING  GLOBAL IN DEX
  86               .Q:($P($G (^CHMX277( TRKI,0))," ^",3)=0)
  87               .S CHTPAR R(CHTPI)=" "              ; SET  CHTPARR UP  FOR GETPE NDEI  
  88               .D GETTOF ROM(CHTPI)  Q:('CHFRO M)  ; RETR IEVE FROM/ TO FROM TR ACKING GLO BAL
  89               .D GETPEN DEI(CHFROM ,CHTO)  ;  GENERATE ^ ZSC ARRAY  OF ^CHMXCL E(I) VALUE S
  90               .Q:^ZSC($ J,0)=0             ;  NO RECORDS  FOUND, CR EATE NO FI LE
  91               .D CREATE FILE               ;  CREATE THE  PENDING S TATUS FILE
  92               .D FMUPDA TE(CHTPI)          ;  UPDATE TRA CKING GLOB AL VIA FIL EMAN FUNCT ION
  93               Q
  94               ;
  95   EPFTESTF         ; 9/ 24/13 TEST  LABEL FOR  FULL FINA L STATUS F ILE CREATI ON - INITI AL RUN
  96               N FULL S  FULL=1
  97               D EPFTEST
  98               Q
  99   EPFTEST ;  TEST LABEL  FOR FINAL  STATUS FI LE CREATIO N
  100               ; 5/16/13  HAPE POR  DO#118-11- D-1009, TO #118-1009- 0001
  101               N TEST S  TEST=1
  102               D EPFINAL
  103               Q
  104   EPFFULL ;  9/24/13 HA PE POR lab el for FUL L Final St atus file  creation -  Initial r un
  105               N FULL S  FULL=1
  106               D EPFINAL
  107               Q
  108   EPFINAL ;  6/1/13 HAP E POR DO#1 18-11-D-10 09, TO#118 -1009-0001
  109               ; HAPE PO R - implem ent creati on of Fina l Status f ile for
  110               ; CHAMPVA , SB, CWVV  programs
  111               L +^CHMXW B21:5  I ' $T W !,"Pr ocess alre ady runnin g." Q
  112               N RUNTYPE ,GRPCNT,EI CNT,GROUPI D,CHTPI,CH TPARR
  113               N TRKI,FI LECNT,FMDA TE,RUNDATE ,CHRJARR,C HMEDCOB,TI ME,CHCLFI
  114               N COUNT,D IRFILE,DAT ESTAMP,STV AL
  115               N BREF,MA XCNT ; FIL EMAN UPDAT E VARIABLE S
  116               S RUNTYPE ="F",EICNT =0,RUNDATE =$H
  117               D INIT
  118               ;TRADING  PARTNERS F ROM "B" XR EF
  119               S CHTPI=" A"
  120               F  S CHTP I=$O(^CHMX 277("B",CH TPI),-1) Q :CHTPI=""   D
  121               . ;KILL T RADING PAR TNER ARRAY
  122               . K CHTPA RR
  123               . ;HAPE P OR - 5/16/ 13 INITIAL IZE FILE C NT AND COB  FLAG
  124               . S (FILE CNT,CHMEDC OB)=0
  125               . ;GET TR ACKING GLO BAL INDEX
  126               . S TRKI= $O(^CHMX27 7("B",CHTP I,0))
  127               . I $P($G (^CHMX277( TRKI,0))," ^",3)=0 Q
  128               . ;TRADIN G PARTNER  11 = "COB"  EMDEON PA RTNER
  129               . I $P(^C HMX277(TRK I,0),"^",4 )["COB" S  CHMEDCOB=1
  130               . S CHTPA RR(CHTPI)= ""
  131               . ;GENERA TE ^ZSC AR RAY OF ^CH MXCLE(I) V ALUES
  132               . D GETFI NEI
  133               . ;NO REC ORDS FOUND , CREATE N O FILE
  134               . Q:^ZSC( $J,0)=0
  135               . ;CREATE  THE FINAL  STATUS FI LE
  136               . D CREAT EFILE
  137               . ;HAPE P OR - UPDAT E ^CHMPAY( "E") INDEX  AS INCLUD ED IN FINA L STATUS
  138               . D FMUPD ATE(CHTPI)
  139               L -^CHMXW B21
  140               Q
  141               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  142               ; HISTORI CAL STATUS  RECORD GE NERATION E NTRY POINT S      ;
  143               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  144   EPREPTST         ;
  145               N TEST S  TEST=1
  146               D EPREPLA CEMENT
  147               Q
  148               ;
  149   EPREPLACEM ENT   ;
  150               N COUNT,D IRFILE,GRP CNT,SEQCNT ,LSTTIME,H OLD,DATEST AMP,STVAL, RUNTYPE,FM DATE,MAXCN T
  151               N POP,CHM XI,CHENDI, FROM,TO,TP ,RUNTYPE,C HTPI,EICNT ,CHMEDCOB, IDX,CHTPX
  152               S RUNTYPE ="H",FILEC NT=0,GRPCN T=1,EICNT= 0,CHTPI=0   ; INITIAL IZE FROM/T O INDICES, STATUS TYP E
  153               D INIT
  154               S GROUPID ="REPLACEM ENT"
  155               S TP=$$LI STTP^CHMXW B22  ; SEL ECT TRADIN G PARTNER
  156               S CHMEDCO B=0             ; ASS UME NOT A  "COB" TRAD ING PARTNE R
  157               S IDX=$O( ^CHMX277(" B",TP,0))
  158               S:$P(^CHM X277(IDX,0 ),"^",4)[" COB" CHMED COB=1  ; T RADING PAR TNER 11 =  "COB" EMDE ON PARTNER
  159               D GETDTE^ CHMXWBUT(. FROM,.TO)                    ; G ET DATE RA NGE VALUES
  160               S IDATE=F ROM,EDATE= TO_".99999 9"
  161               F  S IDAT E=$O(^CHMX CL("B",IDA TE)) Q:IDA TE>EDATE   Q:IDATE=""   D
  162               .S CHXI=" "
  163               .F  S CHX I=$O(^CHMX CL("B",IDA TE,CHXI))  Q:CHXI=""   D
  164               ..S CHMXI =CHXI
  165               ..I $D(TE ST) W !,"C HECKING:", $$DTCVRT($ E(IDATE,1, 7))  ; SHO W FILE DAT ES BEING P ROCESSED
  166               ..S CHA=$ O(^CHMXCLA ("B",CHMXI ,"")) Q:CH A=""
  167               ..S CHTPX =$P($G(^CH MXCLA(CHA, 1)),"^",1)  Q:CHTPX=" "    ; GET  CLAIM T/P  FOR FILE  BEING CHEC KED
  168               ..S CHTPX =$O(^CHMXT P("C",CHTP X,""))  ;  CHECK SELE CTED VS CL AIM TP ID
  169               ..I TP=CH TPX D  ; F ILE MATCHE S THE SELE CTED TP  
  170               ...S CHTP I=TP   ; C HTPI IS US ED DOWNSTR EAM                                              
  171               ...I $D(T EST) W "   PROCESSING :",$$DTCVR T($E(IDATE ,1,7))
  172               ...I $D(T EST) W !,"   EPREPLAC EMENT: CHM XI= ",CHMX I,"  CHA=  ",CHA,"  C HTPI= ",CH TPI,"  TP=  ",TP
  173               ...S CHTP ARR(TP)=""  D GETCHCL EI(CHMXI,C HTPI)                      ; IF  TP VALID,  PROCESS FI LE
  174               I $D(TEST ) W !,"REP LACE: $J=  ",$J,"  RE C COUNT= " ,$G(^ZSC($ J,0)),"  C HTPI= ",CH TPI,"  TP=  ",TP
  175               Q:^ZSC($J ,0)=0  ; N O RECORDS  FOUND, CRE ATE NO FIL E
  176               D CREATEF ILE
  177               Q
  178               ;
  179   DTCVRT(DAT E)    ; CO NVERT DATE  TO EXTERN AL FORMAT
  180               N EXTDATE
  181               S EXTDATE =$E(DATE,4 ,5)_"-"_$E (DATE,6,7) _"-"_($E(D ATE,1,3)+1 700)
  182               Q EXTDATE
  183               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  184               ; HISTORI CAL STATUS  RECORD GE NERATION E NTRY POINT S                            ;
  185               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  186   EPOVERTST        ;
  187               N TEST S  TEST=1
  188               D EPOVERL AY
  189               Q
  190               ;
  191   EPOVERLAY        ;
  192               N COUNT,D IRFILE,GRP CNT,SEQCNT ,LSTTIME,H OLD,DATEST AMP,STVAL, RUNTYPE,FM DATE,MAXCN T
  193               N POP,CHM XI,CHENDI, FROM,TO,TP ,RUNTYPE,C HTPI,EICNT
  194               S RUNTYPE ="O",FILEC NT=0,GRPCN T=1,EICNT= 0,CHTPI=0   ; INITIAL IZE FROM/T O INDICES, STATUS TYP E
  195               D INIT
  196               S GROUPID ="OVERLAY"
  197               S TP=$$LI STTP^CHMXW B22
  198               D GETDTE^ CHMXWBUT(. FROM,.TO)   ; GET DAT E RANGE VA LUES
  199               S IDATE=F ROM,EDATE= TO_".99999 9"
  200               F  S IDAT E=$O(^CHMX CL("B",IDA TE)) Q:IDA TE>EDATE   Q:IDATE=""   D
  201               .S CHMXI= ""
  202               .F  S CHM XI=$O(^CHM XCL("B",ID ATE,CHMXI) ) Q:CHMXI= ""  D
  203               ..S CHA=$ O(^CHMXCLA ("B",CHMXI ,"")) Q:CH A=""
  204               ..S TPTIN =$P($G(^CH MXCLA(CHA, 1)),"^",1)  Q:TPTIN=" "
  205               ..I TP=$O (^CHMXTP(" C",TPTIN," ")) S CHTP ARR(TP)=""  D GETCHCL EI(CHMXI,T P)
  206               Q:^ZSC($J ,0)=0  ; N O RECORDS  FOUND, CRE ATE NO FIL E
  207               D CREATEF ILE
  208               Q
  209               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  210               ; INIT PE RFORMS LOC AL VARIABL E INITIALI ZATION REQ UIREMENTS  FOR THE ST ATUS   ;
  211               ; PROCESS ES.                                                                      ;
  212               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;; 
  213   INIT    ;
  214               K ^ZSC($J ) S ^ZSC($ J,0)=0
  215               K TMP
  216               S GROUPID ="",CHTPI= 0
  217               I '$D(DAT ESTAMP) D   ; PROVIDE D FOR TEST ING, PRODU CTION SHOU LD NOT REQ UIRE THIS
  218               .D NOW^%D TC
  219               .S FMDATE =%
  220               .S FMDATE =$$JUSTIFY ^CHMXWBUT( FMDATE,14, 0,"L")
  221               .S TIME=$ $JUSTIFY^C HMXWBUT($E (FMDATE,9, 14),6,0,"L ")
  222               .S DATEST AMP=($E(FM DATE,1,7)+ 17000000)_ TIME  ; DA TE/TIME FI LE CREATED  DOWN TO S ECOND
  223               Q
  224               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  225               ; EPSTAT  IS THE ENT RY POINT F OR THE ON- DEMAND REP ORT FOR ST ATISICS           ;
  226               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;    
  227   EPSTAT  ;
  228               D ONDEMAN D^CHMXWB22
  229               Q
  230               ;
  231   EPREGEN ;
  232               D REGEN^C HMXWB22
  233               Q
  234               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  235               ; FILE CR EATION FUN CTIONS                                                        ;
  236               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  237   CREATEFILE       ;
  238               S MAXCNT= 500000
  239               ; HAPE PO R 11/21/13  force max  file size  under 150  meg
  240               I RUNTYPE ="F" S MAX CNT=175000
  241               ;I RUNTYP E="P" S MA XCNT=6000   ; MTN0202 86-01 - se t to 5Mb f or TESTing  only - li ttle over  5*1024  == > REMOVE T HIS LINE A FTER TEST
  242               D FILELOO P
  243               Q
  244               ;
  245   FILELOOP         ; BU ILD CLAIMS  FROM ^ZSC ($J) ARRAY  (^CHMXCLE (I) VALUES )
  246               N CHCLEI, PDI,CLMCOS T,CLMOTH,H ACCLM,IPTO HI,CLMDED, IPTAMT,PAT PAY
  247               D GETGRPC NT  ; GET  ESTIMATED  GROUP FILE  COUNT
  248               Q:GRPCNT= 0
  249               D GETFILE  U DIRFILE   ; CREATE  ORIGINAL  FILE           
  250               D BLDHDR               ; BLDHDR  SETS COUN T=2 (SEE E MDEON SPEC )
  251               S CHCLEI= 0
  252               F  S CHCL EI=$O(^ZSC ($J,CHTPI, CHCLEI)) Q :CHCLEI=""   D
  253               .S EICNT= EICNT+1
  254               .S STVAL= $G(^ZSC($J ,CHTPI,CHC LEI))
  255               .I RUNTYP E="F" D
  256               .. S STVA L=""
  257               .. K IPTA MT,IPTOHI
  258               .. ;;HAPE  POR - BUI LD ARRAY O F COST SHA RE AND DED UCTABLE AM TS
  259               .. S HACC LM="" F  S  HACCLM=$O (^CHMXCLE( CHCLEI,80, "B",HACCLM )) Q:HACCL M=""  D
  260               ... I $P( $G(^CHMPAY (HACCLM,1) ),"^",7)'= "" S CLMOT H(HACCLM)= $P(^(1),"^ ",7)
  261               ... I $P( $G(^CHMPAY (HACCLM,1) ),"^",6)'= "" S CLMCO ST(HACCLM) =$P(^(1)," ^",6)
  262               ... I $P( $G(^CHMPAY (HACCLM,1) ),"^",5)'= "" S CLMDE D(HACCLM)= $P(^(1),"^ ",5)
  263               ... I $P( $G(^CHMPAY (HACCLM,1) ),"^",15)' ="" S PATP AY(HACCLM) =$P(^(1)," ^",15)
  264               .D BLDCLM (CHCLEI,ST VAL)  ; GE NERATE CLA IM/STC,DTL /STC RECOR DS
  265               .D CHKSEQ                  ; CH ECK FOR 50 0MB LIMIT,  CREATE NE W FILE
  266               .K CLMCOS T,CLMDED,P ATPAY,CLMO TH
  267               D BLDTRL                   ; BU ILD THE TR AILER RECO RD
  268               D CLOSEFI LE               ; CL OSE CURREN T FILE
  269               Q
  270               ;
  271   GETGRPCNT        ; ES TIMATE THE  TOTAL NUM BER OF FIL ES REQUIRE D
  272               N RECCNT, X
  273               S RECCNT= 0
  274               S X=""
  275               F  S X=$O (^ZSC($J,C HTPI,X)) Q :X=""  S R ECCNT=RECC NT+1
  276               S GRPCNT= RECCNT\MAX CNT   ; IN TEGER DIVI SION OF RE CORD COUNT
  277               S:RECCNT# MAXCNT>0 G RPCNT=GRPC NT+1
  278               ;HAPE POR  1/6/14 -  for FINAL  status, fo rce groupc nt=1
  279               ;HAPE POR  1/20/14 -  force gro up count =  1 for all  cstat typ es, includ ing Pendin g
  280               S GRPCNT= 1
  281               ;; HAPE P OR 1/20/14  I RUNTYPE ="F" S GRP CNT=1
  282               ;W !,"GRP CNT= ",GRP CNT
  283               Q
  284               ;
  285   CHKSEQ  ;  HANDLE THE  FILE SEQU ENCE NUMBE RING REQUI REMENTS
  286               I EICNT>M AXCNT D
  287               .D BLDTRL   ; OUTPUT  TRAILER R ECORD
  288               .D CLOSEF ILE
  289               .D GETFIL E U DIRFIL E
  290               .D BLDHDR   ; BLDHDR  RESETS "C OUNT" VARI ABLE
  291               Q
  292               ;
  293   FMUPDATE(C HTPI) ; UP DATE THE T RACKING GL OBAL USING  FILEMAN
  294               Q:"APF"'[ RUNTYPE  ;  A=ACK, P= PENDING, F =FINAL
  295               ; HAPE PO R - FOR CH AMPVA CLAI MS THAT AR E INCLUDED  IN THE FI NAL
  296               ; STATUS  FILE, SET  ^CHMPAY("E ") = TO DA TE FILE CR EATED
  297               I RUNTYPE ="F" D  Q
  298               . ;02/10/ 2014 SBB D EV020322
  299               . ;N X,X1 ,CNT,NULL  S (NULL,X) ="",CNT=0  F  S X=$O( ^ZSC1($J,X )) Q:X=""   S X1="" F   S X1=$O( ^ZSC1($J,X ,X1)) Q:X1 =""  S CNT =CNT+1 I $ D(^CHMPAY( "E",X,X1))  S ^CHMPAY ("E",X,X1) =$ZD(RUNDA TE)_"#"_RU NDATE
  300               . ; Updat ed code fo r FILE RUN  DATE, the  new field  is now at  10.23 in  CHMPAY and  with a M  cross refe rence
  301               . S %H=RU NDATE D YM D^%DTC N R DT S RDT=X _%
  302               . N X,X1, X2,CNT,NUL L S (NULL, X1)="",CNT =0 F  S X1 =$O(^ZSC1( $J,X1)) Q: X1=""  S X 2="" F  S  X2=$O(^ZSC 1($J,X1,X2 )) Q:X2=""   S CNT=CN T+1 I $D(^ CHMPAY("E" ,X1,X2)) S  DR="10.23 ///^S X=RD T",DIE="^C HMPAY(",DA =X2 D ^DIE
  303               . ;; HAPE  POR 1/20/ 14 added b ack code t o update X 12 277 STA TUS TRACKI NG FILE
  304               . S CHNOD EDEF="^CHM X277(I,30, ",TRKDATA= ".02=1^.03 ="_DIRFILE _"^.04="_N ULL_"^.05= "_NULL_"^. 06="_CNT
  305               . D FM1 Q
  306               N CHNODED EF,BREF,CH IJKVAL,DRD ATA,TRKDAT A
  307               S:RUNTYPE ="A" CHNOD EDEF="^CHM X277(I,10, ",TRKDATA= ".02=1^.03 ="_DIRFILE _"^.04="_C OUNT_"^.05 ="_CHMXI
  308               S:RUNTYPE ="P" CHNOD EDEF="^CHM X277(I,20, ",TRKDATA= ".02=1^.03 ="_DIRFILE _"^.04="_C HTO_"^.05= "_CHFROM_" ^.06="_COU NT
  309               ;HAPE POR  7/30/13 -  not neede d due to u se of CHMP AY("E") in dex to
  310               ;       d etermine c laim inclu sion in Fi nal Status  file
  311               ;S:RUNTYP E="F" CHNO DEDEF="^CH MX277(I,30 ,",TRKDATA =".02=1^.0 3="_DIRFIL E_"^.04="_ CHTO_"^.05 ="_CHFROM_ "^.06="_CO UNT
  312   FM1     ;
  313               S BREF=FM DATE
  314               S CHIJKVA L=$O(^CHMX 277("B",CH TPI,0))             ;  ADD REQUI RES "I", N O "J" VALU E
  315               S DRDATA= $$SETDARR( TRKDATA)                       ;  SET REG/V ALUE FOR F ILEMAN FOR MAT
  316               D ADD^CHH RLIBFM(CHN ODEDEF,CHI JKVAL,BREF ,DRDATA) ;  FILEMAN U PDATE FOR  TRACKING G LOBAL
  317               Q
  318               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  319               ;TEST ENT RY POINT T O TEST THE  BLDCLM FU NCTION FRO M A PDI VA LUE      
  320               ; THERE A RE MULTIPL E CROSS RE FERENCES ( SOME DOCUM ENTED, SOM E
  321               ; UNDOCUM ENTED THAT  ARE UTILI ZED IN THE  CLAIM PRO CESSING SY STEM.
  322               ; THE CVT PDI AND TS TBLDCLM FU NCTIONS UT ILIZE THE  MAJORITY O F THESE
  323               ; CROSS R EFERENCES.
  324               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  325               ;
  326   CVTPDI(CHR EFN)  ;
  327               N CHPCN,C HMXCLI,CHM XID,CHCLFI ,SDATE,EDA TE,CHCLFI, CHCLEI,IDX
  328               I '$D(^CH MXCLE("PDI ",CHREFN))  W !,"NO ^ CHMXCLE("" PDI"",",CH REFN,") XR EF" Q
  329               S CHPCN=" "
  330   S1       S  CHPCN=$O( ^CHMXCLE(" PDI",CHREF N,CHPCN))  I CHPCN=""  Q  ;VALID  PDI,NO DA TA
  331               S CHMXCLI =0
  332   S2       S  CHMXCLI=$ O(^CHMXCLE ("PDI",CHR EFN,CHPCN, CHMXCLI))  I 'CHMXCLI   Q  ;VALI D PDI, NO  DATA
  333               S CHMXID= ""
  334   S3       S  CHMXID=$O (^CHMXCLE( "PDI",CHRE FN,CHPCN,C HMXCLI,CHM XID)) I CH MXID=""  Q
  335               S CHCLEI= $P(CHMXID, "*",4)
  336               W !!,"CLM  SDATE [^C HMXCLE(I,1 )),1]=",$P ($G(^CHMXC LE(CHCLEI, 1)),"^",1)
  337               W !,"CLM  EDATE [^CH MXCLE(I,1) ),2]=",$P( $G(^CHMXCL E(CHCLEI,1 )),"^",2)
  338               S CHCLFI= 0
  339               W !!,"LIN E ITEM DAT E VALUES"
  340               F IDX=1:1  S CHCLFI= $O(^CHMXCL F("B",CHCL EI,CHCLFI) ) Q:'CHCLF I  D  ; CH ECK ALL LI NE ITEM DA TES
  341               .W !,IDX, ". "," L/I  SDATE [^C HMXCLF(I,1 )),11)]=", $P($G(^CHM XCLF(CHCLF I,1)),"^", 11)
  342               .W !,"     L/I END [ ^CHMXCLF(I ,1)),12)]= ",$P($G(^C HMXCLF(CHC LFI,1)),"^ ",12)
  343               .W !,"     THERAPY S DATE [^CHM XCLF(I,2.5 )),1)]=",$ P($G(^CHMX CLF(CHCLFI ,2.5)),"^" ,1)
  344               .W !,"     LAST CERT  DATE [^CH MXCLF(I,2. 5)),2)]=", $P($G(^CHM XCLF(CHCLF I,2.5)),"^ ",2)
  345               Q
  346               ;
  347   TSTBLDCLM( CHPDI)         ;
  348               N CHPCN,C HCLI,CHCLA I,CHCLEI,S TVAL,COUNT ,PDI,BUFI, RUNTYPE,CL MTYPE,TEST
  349               S (STVAL, CHPCN)="", (COUNT,CHC LEI,CHCLAI ,PDI)=0,TE ST=1
  350               S CHPCN=0 ,CHPCN=$O( ^CHMXCLE(" PDI",CHPDI ,CHPCN))
  351               I CHPCN=" " W !,"NO  CHPCN VALU E" Q
  352               E  W !,"P ATIENT CON TROL # [^C HMXCLE(""P DI"",CHPDI ,PCN)]= ", CHPCN         ; PATIE NT CONTROL  NUMBER
  353               S CHCLI=0 ,CHCLI=$O( ^CHMXCLE(" PDI",CHPDI ,CHPCN,CHC LI))
  354               I CHCLI=" " W !,"NO  CHCLI VALU E" Q
  355               S STVAL=0 ,STVAL=$O( ^CHMXCLE(" A",CHCLI,S TVAL)) W ! ,"XREF CLA IM STATUS=  ",STVAL
  356               S BUFI="" ,BUFI=$O(^ CHMXCLE("P DI",CHPDI, CHPCN,CHCL I,BUFI))
  357               I BUFI=""  W !,"NO B UFFER INDE X VALUES"  Q
  358               W !,"XREF  [$O(^CHMX CLE(""PDI" ",CHPDI,CH PCN,CHCLI, BUFI))] BU FFER INDIC ES= ",BUFI
  359               S CHCLEI= $P(BUFI,"* ",4)
  360               I CHCLEI= "" W !,"NO  CHCLEI VA LUE RECOVE RED"
  361               S RUNTYPE ="H"
  362               S PDI=$P( $G(^CHMXCL E(CHCLEI,1 00)),"^",2 )  ; RETRI EVE PDI
  363               S:PDI=""  PDI=$P($G( ^CHMXCLE(C HCLEI,100) ),"^",4)
  364               W !,"PDI  VALUE FROM  [^CHMXCLE (I,100)),2  OR 4]= ", PDI
  365               S CHCLCI= $P(^CHMXCL E(CHCLEI,0 ),"^",1)      ;GET "I " VALUES F OR ALL BUF FER FILES
  366               S CHCLBI= $P(^CHMXCL C(CHCLCI,0 ),"^",1)
  367               S CHCLAI= $P(^CHMXCL B(CHCLBI,0 ),"^",1)
  368               S CHCLI=$ P(^CHMXCLA (CHCLAI,0) ,"^",1)
  369               W !!,"X12  837 BUFFE R [CHMXCL( I)= ",?30, CHCLI
  370               W !,"TRAN SACTION [C HMXCLA(I)] = ",?30,CH CLAI
  371               W !,"PROV IDER BUFFE R [CHMXCLB (I)]= ",?3 0,CHCLBI
  372               W !,"PATI ENT BUFFER  [CHMXCLC( I)= ",?30, CHCLCI
  373               W !,"CLM  BUFFER [CH MXCLE(I)=  ",?30,CHCL EI
  374               W !,"L/I  BUFFER [CH MXCLF(I)]=  ",?30,$O( ^CHMXCLF(" B",CHCLEI, 0))
  375               S CLMTYPE =$$GETCLMT YP
  376               W !,"VERS ION-FUNCTI ONAL TYPE  [^CHMXCLA( I,0)),13)] = ",$P($G( ^CHMXCLA(C HCLAI,0)), "^",13)
  377               W !!,"CLA IM TYPE= " ,$S(CLMTYP E="I":"INS TITUTIONAL ",CLMTYPE= "P":"PROFE SSIONAL",C LMTYPE="D" :"DENTAL")                   ; I /P/D CLAIM
  378               W !,"STAT US (ACK/PE NDING)=",$ S($D(^CHMP AY("C",PDI ))=0:"ACK" ,1:"PENDIN G")
  379               D CVTPDI( CHPDI)
  380               W !!
  381               D BLDCLM( CHCLEI,"")
  382               Q
  383               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  384               ; BLDCLM:  ENTRY POI NT TO BUIL D THE CSTA T RECORDS                      
  385               ; THIS FU NCTION PRO VIDES AN E XTERNAL EN TRY POINT  TO GENERAT E THE
  386               ; EMDEON  CLAIM,CLAI M STATUS,D ETAIL,AND  DETAIL STA TUS RECORD S  
  387               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  388   BLDCLM(CHC LEI,STVAL)     ;BUILD  UP THE CL AIM RECORD S
  389               ;   CHCLE I      CLA IM NUMBER  FROM INCOM ING 837 FI LE
  390               ;   STVAL        STA TUS VALUE  AFTER FROM NT END EDI TS
  391               N CHCLCI, CHCLBI,CHC LAI,CHCLI, STYPE,TMP, OK,HACPAY
  392               N CHKDATE ,CHKEFT,CH MPAY,PAYDA TE,ALLOWAM T,CLTYPE,P IECE,TOC,L N,LD,STCLI CN
  393               I '$D(DAT ESTAMP) D   ; PROVIDE D FOR TEST ING, PRODU CTION SHOU LD NOT REQ UIRE THIS
  394               .D NOW^%D TC
  395               .S FMDATE =%
  396               .S FMDATE =$$JUSTIFY ^CHMXWBUT( FMDATE,14, 0,"L")
  397               .S TIME=$ $JUSTIFY^C HMXWBUT($E (FMDATE,9, 14),6,0,"L ")
  398               .S DATEST AMP=($E(FM DATE,1,7)+ 17000000)_ TIME  ; DA TE/TIME FI LE CREATED  DOWN TO S ECOND
  399               S CHCLCI= $P(^CHMXCL E(CHCLEI,0 ),"^",1)   ;TRAVERSE  BACK THROU GH BUFFER  FILES
  400               S CHCLBI= $P(^CHMXCL C(CHCLCI,0 ),"^",1)   ;GET "I" V ALUES FOR  ALL BUFFER  FILES
  401               S CHCLAI= $P(^CHMXCL B(CHCLBI,0 ),"^",1)
  402               S CHCLI=$ P(^CHMXCLA (CHCLAI,0) ,"^",1)
  403               S:'$D(COU NT) COUNT= 0
  404               K CHRJARR
  405               S STYPE=$ $GETSTYPE( CHCLEI)  ;  "TYPE" PE NDING/ACK/ FINAL
  406               ;HAPE POR  1/6/14 -  if line st atus is di fferent fr om runtype , do not i nclude
  407               I STYPE'= RUNTYPE S  EICNT=$G(E ICNT)-1 Q
  408               ;HAPE POR  1/6/14 -  QUIT MISSI NG AT END  OF LINE
  409               I STYPE=" P" S CHRJA RR(0)=1 S  CHRJARR(1, 1)="P1*45* " D  Q  ;  ALL "PENDI NG" = P1/4 5
  410               .D CLM
  411               .D BLDSTC ("CLM")  ;  EACH CLAI M GETS CLM , STC RECO RDS
  412               ;HAPE POR  1/6/14 -  added QUIT  to end of  STYPE="A"  do
  413               I STYPE=" A" D  Q
  414               .D BLDACK          ;  BUILD "AC K" REJECT  REASON COD ES ARRAY ( CHRJARR)
  415               .I $G(STV AL)="" S S TVAL=$$GET STVAL(CHCL EI)  ; GET  STATUS OF  CLAIM (6= FRONT END  EDIT FAIL)
  416               .I STVAL' =6 S CHRJA RR(0)=1,CH RJARR(1,1) ="A2*20*"   ; NO FRON T END EDIT S GET A2/2 0
  417               .D CLM
  418               .D BLDSTC ("CLM")  ;  ALL "ACKS " GET A ST ATUS
  419               .K CHRJAR R S CHRJAR R(0)=0
  420               .S CHCLFI =0
  421               .F  S CHC LFI=$O(^CH MXCLF("B", CHCLEI,CHC LFI)) Q:CH CLFI=""  D
  422               ..D GLINR JRSN^CHMXW BUT(CHCLFI )
  423               .D:CHRJAR R(0)>0 LIN E  ; NO LI NE REJECTS  RECORDED  = NO LINE  REPORTS
  424               I STYPE=" F" D
  425               . N CLMST AT
  426               . S (CHKD ATE,CHKEFT ,PAYDATE,C HMPAY)=""
  427               . K CHRJA RR S CHRJA RR(0)=1
  428               . S CHCLF I=0
  429               . ;;HAPE  POR - THE  FOLLOWING  ATTEMPTS T O DETERMIN E PROPER S TATUS CODE
  430               . ;; TO R EPORT FOR  THE CLAIM  - 1ST CHEC K FOR REJE CT CLAIM L INES
  431               . ;; THEN  BUILD CLM STAT FROM  CHAMPVA CL AIMS AND W HETHER PAY MENT WAS
  432               . ;; REQU ESTED
  433               . F  S CH CLFI=$O(^C HMXCLF("B" ,CHCLEI,CH CLFI)) Q:C HCLFI=""   D
  434               .. I $P($ G(^CHMXCLF (CHCLFI,10 0)),"^") D
  435               ... I $G( CHRJARR(1, 1))=""!($G (CHRJARR(1 ,1))="F2*1 *") S CHRJ ARR(1,1)=" F2*1*" Q
  436               ... S CHR JARR(1,1)= "F0*1*"
  437               ... Q
  438               . S CHMPA Y="" F  S  CHMPAY=$O( ^CHMXCLE(C HCLEI,80," B",CHMPAY) ) Q:CHMPAY =""  D
  439               .. I $G(H ACPAY(CHMP AY))="" S  HACPAY(CHM PAY)=$P($G (^CHMPAY(C HMPAY,1)), "^")
  440               .. I $P($ G(^CHMPAY( CHMPAY,1)) ,"^",4)>CH KDATE S CH KDATE=$P(^ (1),"^",4) ,CHKEFT=$P (^(1),"^", 16)
  441               .. I $P($ G(^CHMPAY( CHMPAY,0)) ,"^",10)>P AYDATE S P AYDATE=$P( ^(0),"^",1 0)
  442               .. I '$D( ^CHMSNA(74 1008.2,"AB ",CHMPAY)) ,'$D(^CHMS NA(741008. 3,"D",CHMP AY)) S CLM STAT=$G(CL MSTAT)_";0 " Q
  443               .. S CLMS TAT=$G(CLM STAT)_";"_ $P(^CHMPAY (CHMPAY,0) ,"^",2)
  444               .. S TOC= $$TOS^CH83 5FU1($P($G (^CHMPAY(C HMPAY,0)), "^",7))
  445               .. S CLTY PE=$S(TOC= "IPT":"INP -REV",TOC= "OPT":"OPT -PROC",TOC ="RXT":"PH ARM",TOC=" DUR":"DME- SUPPLY",TO C="DNT":"D EN-PROC",T OC="TRV":" OPT-PROC", 1:"OPT-PRO C")
  446               .. S PIEC E=$S(TOC=" DNT":"1;2; 5",TOC="DU R":"1;2;4" ,TOC="IPT" :"1;2;5",T OC="OPT":" 1;2;3",TOC ="RXT":"2; 4;5",TOC=" TRV":"1;2; 3",1:"")
  447               .. I PIEC E="" Q
  448               .. I $P($ G(^CHMPAY( CHMPAY,0)) ,"^",2)=4  D
  449               ... I TOC ="IPT" S C LMSTAT=$G( CLMSTAT)_" ;4" Q
  450               ... S LN= 0,OK=0 F   S LN=$O(^C HMPAY(CHMP AY,CLTYPE, LN)) Q:'LN   S LD=$G( ^(LN,0)) D
  451               .... S AL LOWAMT=$P( LD,"^",$P( PIECE,";", 3))
  452               .... ;HAP E POR - IF  ALLOWABLE  AMOUNT IS  NOT >0, T HEN ASSUME  LINE STAT US
  453               .... ;          SHOU LD BE F0
  454               .... I AL LOWAMT'>0  S CLMSTAT= $G(CLMSTAT )_";0"
  455               . I $F(CL MSTAT,";0" ),$F(CLMST AT,";4") S  CHRJARR(1 ,1)="F0*1* "
  456               . I '$F(C LMSTAT,";0 ") S CHRJA RR(1,1)="F 1*65*"
  457               . I '$F(C LMSTAT,";4 ") S CHRJA RR(1,1)="F 2*1*"
  458               . S CHKDA TE=$P(CHKD ATE,"."),P AYDATE=$P( PAYDATE,". ")
  459               . I CHKDA TE'="" S C HKDATE=CHK DATE+17000 000
  460               . I PAYDA TE'="" S P AYDATE=PAY DATE+17000 000
  461               . D CLM
  462               . D BLDST C("CLM")
  463               . D LINE
  464               Q
  465               ;
  466   GETSTYPE(C HCLEI)         ; TYPE  OF CLAIM  STATUS FOR  BLDSTC()
  467               N PDI
  468               I $$FINAL (CHCLEI) Q  "F"
  469               S PDI=$P( $G(^CHMXCL E(CHCLEI,1 00)),"^",2 )  ; IF PD I ASSIGNED , CHECK FO R "PENDING "
  470               S:PDI=""  PDI=$P($G( ^CHMXCLE(C HCLEI,100) ),"^",4)
  471               I PDI I $ D(^CHMPAY( "C",PDI))  Q "P"
  472               Q "A"  ;  NO PDI, MU ST BE "ACK "
  473               ;
  474   FINAL(CHCL EI)   ; HA PE POR - F INAL STATU S
  475               ; ONLY CL AIMS THAT  HAVE CLAIM  STATUS OF  EITHER
  476               ; REJECTE D(0) OR CO MPLETE(4)
  477               N CHMPAY, OK
  478               S OK=0
  479               I $O(^CHM XCLE(CHCLE I,80,"B",0 )) D
  480               . S CHMPA Y=0,OK=1
  481               . F  S CH MPAY=$O(^C HMXCLE(CHC LEI,80,"B" ,CHMPAY))  Q:CHMPAY=" "  D  Q:'O K
  482               .. I $P($ G(^CHMPAY( CHMPAY,0)) ,"^",2)=4  Q
  483               .. I $P($ G(^CHMPAY( CHMPAY,0)) ,"^",2)=0  Q
  484               .. S OK=0
  485               .. Q
  486               Q OK
  487               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  488               ; FUNCTIO NS TO GATH ER INFORMA TION REGAR DING REJEC T REASONS    ;
  489               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;   
  490               ;
  491   BLDACK  ;  POPULATE C HRJARR REJ ECT REASON /REJECT CO DE VALUES
  492               K CHRJARR   S CHRJAR R(0)=0
  493               ; CLEAR T HE REJECT  REASON ARR AY
  494               S REJCODE S=""
  495               D GTRXRJR SN^CHMXWBU T(CHCLAI)   ; TRANSAC TION "101"  NODE REJE CT REASONS
  496               D GPRORJR SN^CHMXWBU T(CHCLBI)   ; PROVIDE R "101" NO DE REJECT  REASONS
  497               D GPATRJR SN^CHMXWBU T(CHCLCI)   ; PATIENT  "101" NOD E REJECT R EASONS
  498               D GCLMRJR SN^CHMXWBU T(CHCLEI)   ; CLAIM " 101" NODE  REJECT REA SONS
  499               I CHRJARR (0)=0 S CH RJARR(0)=1 ,CHRJARR(1 ,1)="A3*24 7*"
  500               ;I $D(TES T) W !,"BL DACK: RJCN T=",CHRJAR R(0),"  RJ ARR(1,1)=" ,CHRJARR(1 ,1)
  501               Q
  502               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;
  503               ; RECORD  BUILDING F UNCTIONS:   $TEXT FIL ES PROVIDE  FIELD DEF INTIONS       ;
  504               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;
  505   BLDHDR  ;B UILD HEADE R RECORD
  506               N LN,REC, STR,LOADTY PE,PAYNAME ,PAYPHONE
  507               S (STR,LN ,REC)="",C OUNT=2  ;  EMDEON SPE C: REC. CO UNT STARTS  @ 2
  508               D GETHDRV AL                 ;  SET UP HEA DER VARIAB LES
  509               F LN=1:1  S STR=$T(E MDEONHDR+L N) Q:STR[" END OF REC ORD"  D
  510               .I LN=1 S  REC=REC_$ $FORMATDAT A^CHMXWBUT (STR)
  511               .E  S REC =REC_"|"_$ $FORMATDAT A^CHMXWBUT (STR)
  512               W REC,! S  REC=""
  513               Q
  514               ;
  515   CLM     ;
  516               N BPFTI,B PPN,BPNID, BPLNAME,BP FNAME,BPMN AME,SPFTID
  517               N SPPN,SP NID,SPLNAM E,SPFNAME, EMPIDNUM,E MPNAME,SUB SCID,SUBLN AME
  518               N SUBFNAM E,SUBMNAME ,SUBNAMEX, PATID,PATL NAME,PATFN AME,PATMNA ME,PATNAME X,PATDOB
  519               N PATGEND R,ECLMNUM, CLMCHRG,CL MPMT,CAPD, CHKEFTDATE ,CHKEFTNUM ,BTYPE,PCI DNUM
  520               N PATACCT ,PRSCNUM,V OUCHID,LOC SYSID,GRPN UM,CLMSTDT ,CLMENDT
  521               N PDI,CHM PAYI,REC,L N,STR,SVCD ATES,SPMNA ME,SPNAMEX ,BPNAMEX
  522               ; DO ACK  AND PENDIN G
  523               ; HAPE PO R 7/8/13 A dding FINA L
  524               S PDI=$P( $G(^CHMXCL E(CHCLEI,1 00)),"^",2 )  ; IF PD I ASSIGNED , MUST BE  "PENDING"
  525               I PDI=""  S PDI=$P($ G(^CHMXCLE (CHCLEI,10 0)),"^",4)
  526               I PDI'=""  S CHMPAYI =$O(^CHMPA Y("C",PDI, 0))
  527               D GETCLMV AL              ; SET  UP THE CL AIM VALUE  VARIABLES
  528               S REC=""                  ; BUI LD THE REC ORD
  529               F LN=1:1  S STR=$T(E MDEONCLM+L N) Q:STR[" END OF REC ORD"  D
  530               .I LN=1 S  REC=REC_$ $FORMATDAT A^CHMXWBUT (STR)
  531               .E  S REC =REC_"|"_$ $FORMATDAT A^CHMXWBUT (STR)
  532               W REC,! S  REC="",CO UNT=COUNT+ 1
  533               Q
  534               ;
  535   LINE    ;  BUILD DTL  RECORDS FO R LINE ITE MS
  536               N CLMLINK
  537               N PCID,LI CN,SQID,SI CODE,PRCM1 ,PRCM2,PRC M3,PRCM4,L ICHRGA,LIP PA
  538               N RVNUCOD E,QTYUOS,S VCSTDATE,S VCENDATE
  539               N LN,HACC LM,LNDATA, LNDATA1,OK ,X1
  540               N XCLFHAC ,SERVLN,AL LOWAMT,CLT YPE,ECLMNU M,PROCAMT, PROCCODE
  541               N PROCINT ,PROCUNIT, CHECK,ORGC AMT,AGAIN, CLMCHRG,LA STAMT
  542               S CLMCHRG =$S($P(^CH MXCLE(CHCL EI,2),"^") '>0:"0.00" ,1:$P(^CHM XCLE(CHCLE I,2),"^"))
  543               I RUNTYPE ="F" D CHE CK^CHMXWB2 4 I $G(CLM LINK)=0 D  LINE^CHMXW B24 Q
  544               ;HAPE POR  7/8/13 -  attempt to  put line  items back  together  after
  545               ; CP&E Cl aims proce ssing soft ware split  original  claim line s
  546               S (AGAIN, CHCLFI)=0
  547               F  S CHCL FI=$O(^CHM XCLF("B",C HCLEI,CHCL FI)) Q:CHC LFI=""  S  CHECK=0 D
  548               . ;HAPE P OR - if no  charge am ount, then  skip SERV ICE LINE L EVEL entry
  549               . ; In or der to pro perly repo rt final c laim statu s, origina l 837
  550               . ; claim  must be p ut back to gether wit h CHAMPVA  Claims.
  551               . ; Since  there is  no direct  link, then  a logical  process n eeds
  552               . ; to be  used to a ssociate e ach X12 83 7 BUFFER S ERVICE LIN E entry
  553               . ; with  the associ ated ^CHMP AY claims  entries.
  554               . I RUNTY PE="F" Q:$ P($G(^CHMX CLF(CHCLFI ,1)),"^",6 )=""  D
  555               .. S SERV LN=$P(^CHM XCLF(CHCLF I,0),"^",2 )
  556               .. S PROC CODE=$P(^C HMXCLF(CHC LFI,1),"^" ,3),PROCAM T=$P(^(1), "^",6),ORG CAMT=""
  557               .. S PROC UNIT=$FN($ P(^(1),"^" ,8)+.49,"" ,0)
  558               .. I PROC CODE'="" S  PROCINT=$ O(^CHMSERV ("B",PROCC ODE,""))
  559               .. I PROC UNIT="" S  PROCUNIT=1
  560               .. ;HAPE  POR - if #  of units  is >1 then  look for  multiple l ines
  561               .. ;          in the  CHAMPVA C LAIMS file  for this  same proce dure
  562               .. ;          and se rvice date  that tota l the orig inal # uni ts.
  563               .. I PROC UNIT>1 D
  564               ... S ORG CAMT=PROCA MT,PROCAMT =PROCAMT/P ROCUNIT,PR OCAMT=$FN( PROCAMT,"" ,2)
  565               ... I $FN (PROCAMT*P ROCUNIT,"" ,2)=$FN(OR GCAMT,"",2 ) Q
  566               ... S LAS TAMT=PROCA MT*(PROCUN IT-1),LAST AMT=ORGCAM T-LASTAMT
  567               .. S HACC LM="" F  S  HACCLM=$O (^CHMXCLE( CHCLEI,80, "B",HACCLM )) Q:HACCL M=""  D  Q :$G(OK)
  568               ... S TOC =$$TOS^CH8 35FU1($P($ G(^CHMPAY( HACCLM,0)) ,"^",7))
  569               ... I TOC ="IPT" D
  570               .... S PR OCUNIT=1,P ROCAMT=$P( ^CHMXCLF(C HCLFI,1)," ^",6)
  571               .... I $G (IPTOHI(HA CCLM))=""  S IPTOHI(H ACCLM)=$P( $G(^CHMPAY (HACCLM,1) ),"^",7)
  572               .... I '$ D(^CHMPAY( HACCLM,"IN P-ITEM")), $G(IPTAMT( HACCLM))=" " S IPTAMT (HACCLM)=$ P($G(^CHMP AY(HACCLM, 1)),"^",14 )
  573               ... S CLT YPE=$S(TOC ="IPT":"IN P-REV",TOC ="OPT":"OP T-PROC",TO C="RXT":"P HARM",TOC= "DUR":"DME -SUPPLY",T OC="DNT":" DEN-PROC", TOC="TRV": "OPT-PROC" ,1:"OPT-PR OC")
  574               ... S PIE CE=$S(TOC= "DNT":"1;2 ;5",TOC="D UR":"1;2;4 ",TOC="IPT ":"1;2;5", TOC="OPT": "1;2;3",TO C="RXT":"2 ;4;5",TOC= "TRV":"1;2 ;3",1:"")
  575               ... I PIE CE="" Q
  576               ... ; HAP E POR - lo ok thru CH MPAY lines , looking  for a matc h, if foun d OK=1
  577               ... S (AG AIN,LN,OK) =0 F  S LN =$O(^CHMPA Y(HACCLM,C LTYPE,LN))  D:'LN&('A GAIN) AGAI N  Q:'LN   S LD=$G(^( LN,0)) D   Q:OK
  578               .... I TO C="OPT",$L (LD,"^")'> 3 Q  ;HAPE  POR for i ncomplete  line info
  579               .... ; HA PE POR - i f X12 837  BUFFER SER VICE LINE  LEVEL entr y
  580               .... ; is  already m apped to a  CHAMPVA C LAIM, skip  it.
  581               .... I $D (LNDATA1(H ACCLM,LN))  Q
  582               .... I $P (LD,"^",$P (PIECE,";" ))=$G(PROC INT),$FN($ P(LD,"^",$ P(PIECE,"; ",2)),"",2 )=$FN(PROC AMT,"",2)  S OK=$S($G (CHECK):$$ CHECK(HACC LM,CHCLFI) ,1:1) Q
  583               .... I AG AIN,$G(ORG CAMT),PROC UNIT>1,$FN ($P(LD,"^" ,$P(PIECE, ";",2)),"" ,2)'>$FN(O RGCAMT,"", 2) D
  584               ..... I $ FN($P(LD," ^",$P(PIEC E,";",2)), "",2)="0.0 0" Q
  585               ..... I ' $F(ORGCAMT /$P(LD,"^" ,$P(PIECE, ";",2)),". ") S PROCA MT=$P(LD," ^",$P(PIEC E,";",2)), PROCUNIT=O RGCAMT/PRO CAMT S OK= $S($G(CHEC K):$$CHECK (HACCLM,CH CLFI),1:1)  Q
  586               .... I AG AIN,$FN($P (LD,"^",$P (PIECE,";" ,2)),"",2) =$FN(PROCA MT,"",2),$ O(^CHMPAY( HACCLM,CLT YPE,LN))=" " S OK=$S( $G(CHECK): $$CHECK(HA CCLM,CHCLF I),1:1) Q
  587               .... I AG AIN,$P(LD, "^",$P(PIE CE,";"))=$ G(PROCINT) ,$O(^CHMPA Y(HACCLM,C LTYPE,LN)) ="",$D(LND ATA1(HACCL M)) S OK=$ S($G(CHECK ):$$CHECK( HACCLM,CHC LFI),1:1)  Q
  588               .... I AG AIN,$FN($P (LD,"^",$P (PIECE,";" ,2)),"",2) =$FN(PROCA MT,"",2) S  OK=$S($G( CHECK):$$C HECK(HACCL M,CHCLFI), 1:1) Q
  589               .... I $G (ORGCAMT), $FN($P(LD, "^",$P(PIE CE,";",2)) ,"",2)=$FN (ORGCAMT," ",2) S OK= $S($G(CHEC K):$$CHECK (HACCLM,CH CLFI),1:1) ,PROCUNIT= 1 Q
  590               .... I TO C="IPT",$F N($P(LD,"^ ",$P(PIECE ,";",2))," ",2)=$FN(P ROCAMT,"", 2) D  S OK =$S($G(CHE CK):$$CHEC K(HACCLM,C HCLFI),1:1 ) Q
  591               ..... I $ G(IPTOHI(H ACCLM))>PR OCAMT S IP TOHI(HACCL M,CHCLFI)= PROCAMT,IP TOHI(HACCL M)=IPTOHI( HACCLM)-PR OCAMT Q
  592               ..... S I PTOHI(HACC LM,CHCLFI) =IPTOHI(HA CCLM),IPTO HI(HACCLM) =0
  593               .... ;I A GAIN,'$O(^ CHMXCLF("B ",CHCLEI,C HCLFI)),PR OCAMT=CLMC HRG,$D(LND ATA1(HACCL M)) S OK=$ S($G(CHECK ):$$CHECK( HACCLM,CHC LFI),1:1)  Q
  594               ... I LN' =+LN Q  ;H APE POR -  reached th e end of l ines with  no match
  595               ... I OK, $P(^CHMPAY (HACCLM,0) ,"^",2)'=4  S OK=$$CH ECK(HACCLM ,CHCLFI) I  OK S CHEC K=1,OK=0
  596               ... ;HAPE  POR 7/16/ 13 - PROBL EM FOUND W ITH MULTIP LE CHMPAY  ENTRIES FO R THE SAME  LINE,USE  MOST RECEN T
  597               ... K LND ATA(SERVLN )
  598               ... ;HAPE  POR - LND ATA array  is used to  setup map ping of li nes
  599               ... ;   S ERVLN from  X12 837 B UFFER SERV ICE LINE L EVEL FILE
  600               ... ;   M APPED TO E ACH CHAMPV A CLAIMS I NTERNAL VA LUE (HACCL M)
  601               ... ;   A ND THE ASS OCIATED LI NE NUMBER  (LN).  KEE P IN MIND  THERE
  602               ... ;   M AY BE MULT IPLES FOR  UNITS > 1
  603               ... ;   
  604               ... ;   L NDATA1 arr ay is used  to make s ure lines  are not ma pped
  605               ... ;            mul tiple time s.
  606               ... S LND ATA(SERVLN ,HACCLM,LN )=LD,LNDAT A1(HACCLM, LN)=""
  607               ... S CLM CHRG=CLMCH RG-PROCAMT
  608               ... I PRO CUNIT>1 D
  609               .... S PR OCUNIT=PRO CUNIT-1    ;;;,PROCUN IT=$FN(PRO CUNIT+.49, "",0)
  610               .... F I= 1:1:PROCUN IT S LN=$O (^CHMPAY(H ACCLM,CLTY PE,LN)) Q: 'LN  S LD= $G(^(LN,0) ) D  S ORG CAMT=ORGCA MT-PROCAMT
  611               ..... I O RGCAMT<PRO CAMT S PRO CAMT=ORGCA MT
  612               ..... I O RGCAMT<(PR OCAMT+.05)  S PROCAMT =ORGCAMT
  613               ..... I $ P(LD,"^",$ P(PIECE,"; "))=$G(PRO CINT),$FN( $P(LD,"^", $P(PIECE," ;",2)),"", 2)=$FN(PRO CAMT,"",2)  D  Q
  614               ...... S  LNDATA(SER VLN,HACCLM ,LN)=LD
  615               ...... S  LNDATA1(HA CCLM,LN)=" "
  616               ..... I I =PROCUNIT, $P(LD,"^", $P(PIECE," ;"))=$G(PR OCINT) D   Q
  617               ...... S  LNDATA(SER VLN,HACCLM ,LN)=LD
  618               ...... S  LNDATA1(HA CCLM,LN)=" "
  619               ..... I I =PROCUNIT, $G(LASTAMT ),$FN($P(L D,"^",$P(P IECE,";",2 )),"",2)=$ FN(LASTAMT ,"",2) D   Q
  620               ...... S  LNDATA(SER VLN,HACCLM ,LN)=LD
  621               ...... S  LNDATA1(HA CCLM,LN)=" "
  622               ..... I $ FN($P(LD," ^",$P(PIEC E,";",2)), "",2)=$FN( PROCAMT,"" ,2) D  Q
  623               ...... S  LNDATA(SER VLN,HACCLM ,LN)=LD
  624               ...... S  LNDATA1(HA CCLM,LN)=" "
  625               ..... I $ FN($P(LD," ^",$P(PIEC E,";",2)), "",2)=$FN( PROCAMT-.0 05,"",2) D   Q
  626               ...... S  LNDATA(SER VLN,HACCLM ,LN)=LD
  627               ...... S  LNDATA1(HA CCLM,LN)=" "
  628               ..... Q
  629               .... Q
  630               ... ;HAPE  POR 7/8/1 3 - used t o associat e X12 837  BUFFER LIN E LEVEL en tries
  631               ... ;                    to HAC  claim #
  632               ... ;       XCLFHAC  array is u sed to det ermine pro per line l evel statu s code
  633               ... ;       to repor t in the S TC record
  634               ... I OK  D
  635               .... K XC LFHAC(CHCL FI)
  636               .... ; HA PE POR 7/3 1/13 - for  split cla im lines d ue to Unit s>1
  637               .... ; if  the last  item's all owable amo unt was ch anged to 0
  638               .... ; en tire line  would be s et to F2.   so, check ing to see  if
  639               .... ; th ere are an y lines wi th a posit ive allowa ble amount , then F1
  640               .... I TO C'="IPT",$ P(LD,"^",$ P(PIECE,"; ",3))'>0 D
  641               ..... S X =0 F  S X= $O(LNDATA( SERVLN,HAC CLM,X)) Q: X=""  S X1 =LNDATA(SE RVLN,HACCL M,X) I $P( X1,"^",$P( PIECE,";", 3))>0 S LD =X1 Q
  642               .... I TO C="IPT" S  XCLFHAC(CH CLFI)=$G(^ CHMPAY(HAC CLM,"INP-I TEM",LN,0) ) I XCLFHA C(CHCLFI)= "" D
  643               ..... I $ P(LD,"^",2 )-$G(IPTOH I(HACCLM,C HCLFI))'<I PTAMT(HACC LM) S $P(L D,"^",5)=I PTAMT(HACC LM),LNDATA (SERVLN,HA CCLM,LN)=L D,IPTAMT(H ACCLM)=0,I PTAMT(HACC LM,CHCLFI) =$P(LD,"^" ,5) Q
  644               ..... S $ P(LD,"^",5 )=$P(LD,"^ ",2)-$G(IP TOHI(HACCL M,CHCLFI)) ,LNDATA(SE RVLN,HACCL M,LN)=LD,I PTAMT(HACC LM)=IPTAMT (HACCLM)-$ P(LD,"^",5 ),IPTAMT(H ACCLM,CHCL FI)=$P(LD, "^",5)
  645               .... S XC LFHAC(CHCL FI)=LD,XCL FHAC(CHCLF I,HACCLM)= ""
  646               ... Q
  647               .I RUNTYP E="F",'$D( XCLFHAC(CH CLFI)) S H ACCLM=$O(L NDATA(SERV LN,"")) I  HACCLM S L N=$O(LNDAT A(SERVLN,H ACCLM,""))  I LN S XC LFHAC(CHCL FI)=$G(LND ATA(SERVLN ,HACCLM,LN ))
  648               .; HAPE P OR 7/8/13  - need sta tus value  prior to D  GDTLVARS
  649               .I RUNTYP E="F" D
  650               .. K CHRJ ARR S CHRJ ARR(0)=1
  651               .. I $P($ G(^CHMXCLF (CHCLFI,10 0)),"^") S  CHRJARR(1 ,1)="F2*1* " Q
  652               .. I $G(C HRJARR(1,1 ))="" S CH MPAY=$P($G (^CHMXCLF( CHCLFI,80) ),"^") I C HMPAY'=""  D
  653               ... I '$D (^CHMSNA(7 41008.2,"A B",CHMPAY) ),'$D(^CHM SNA(741008 .3,"D",CHM PAY)) S CH RJARR(1,1) ="F2*1*" Q
  654               ... I $P( $G(^CHMPAY (CHMPAY,0) ),"^",2)=0  S CHRJARR (1,1)="F2* 1*" Q
  655               ... I $P( $G(^CHMPAY (CHMPAY,0) ),"^",2)=4  S CHRJARR (1,1)="F1* 65*" Q
  656               .. I $G(C HRJARR(1,1 ))="",$D(X CLFHAC(CHC LFI)) S CH MPAY=$O(XC LFHAC(CHCL FI,"")) I  CHMPAY D   I CHRJARR( 1,1)'="" Q
  657               ... I '$D (^CHMSNA(7 41008.2,"A B",CHMPAY) ),'$D(^CHM SNA(741008 .3,"D",CHM PAY)) S CH RJARR(1,1) ="F2*1*" Q
  658               ... I $P( $G(^CHMPAY (CHMPAY,0) ),"^",2)=4  D  Q
  659               .... I TO C="IPT" S  CHRJARR(1, 1)="F1*65* " Q
  660               .... S AL LOWAMT=$P( XCLFHAC(CH CLFI),"^", $P(PIECE," ;",3))
  661               .... I AL LOWAMT>0 S  CHRJARR(1 ,1)="F1*65 *" Q
  662               .... ;HAP E POR - if  complete,  but allow able amt=0 , then F2  status
  663               .... S CH RJARR(1,1) ="F2*1*"
  664               ... I $P( $G(^CHMPAY (CHMPAY,0) ),"^",2)=0  S CHRJARR (1,1)="F2* 1*" Q
  665               .. I $G(C HRJARR(1,1 ))="" S CH MPAY="" F   S CHMPAY= $O(^CHMXCL E(CHCLEI,8 0,"B",CHMP AY)) Q:CHM PAY=""  D   I CHRJARR (1,1)'=""  Q
  666               ... I '$D (^CHMSNA(7 41008.2,"A B",CHMPAY) ),'$D(^CHM SNA(741008 .3,"D",CHM PAY)) S CH RJARR(1,1) ="F2*1*" Q
  667               ... I $P( $G(^CHMPAY (CHMPAY,0) ),"^",2)=4  S CHRJARR (1,1)="F1* 65*" Q
  668               ... I $P( $G(^CHMPAY (CHMPAY,0) ),"^",2)=0  S CHRJARR (1,1)="F2* 1*" Q
  669               .. I $G(C HRJARR(1,1 ))="" S CH RJARR(1,1) ="F2*1*"
  670               . D GDTLV ARS
  671               . D BLDLI NE
  672               . Q
  673               Q
  674   BLDLINE ;
  675               N LN,REC, STR
  676               S REC=""
  677               F LN=1:1  S STR=$T(E MDEONLI+LN ) Q:STR["E ND OF RECO RD"  D
  678               .I LN=1 S  REC=REC_$ $FORMATDAT A^CHMXWBUT (STR)
  679               .E  S REC =REC_"|"_$ $FORMATDAT A^CHMXWBUT (STR)
  680               W REC,! S  REC="" S  COUNT=COUN T+1
  681               I RUNTYPE '="F" D
  682               . K CHRJA RR  S CHRJ ARR(0)=0      ; CLEAR  THE REJEC T REASON A RRAY
  683               . D GLINR JRSN^CHMXW BUT(CHCLFI )  ; SERVI CE LINE "1 01" NODE R EJECT REAS ONS
  684               I RUNTYPE '="F",CHRJ ARR(0)=0 S  CHRJARR(0 )=1,CHRJAR R(1,1)="A3 *247*"
  685               D BLDSTC( "DTL")
  686               Q
  687               ;
  688   BLDSTC(TYP E)    ; WR ITE OUT TH E STC RECO RDS FROM C HRJARR REJ ECT ARRAY
  689               ;   TYPE     CLAIM O R DETAIL L EVEL EMDEO N STATUS V ALUES & LI NE ITEM CO NTROL NUMB ER
  690               N PCINUM, LICNUM,DAT ERR,ESCODE ,ENTITY
  691               N IDX,JDX ,REJCODES, ECNT,RJCOD E,RJSTATUS
  692               N LN,STR, REC
  693               S REJCODE S=0
  694               S ECNT=CH RJARR(0)                           ; FRONT  END EDIT R EJECT COUN T
  695               F IDX=1:1  Q:(IDX>EC NT)  D                  ; PROVID E STC RECO RD FOR EAC H ERROR
  696               .F JDX=1: 1 Q:$G(CHR JARR(IDX,J DX))=""  D   ; GET EA CH REJECT  VALUE STOR ED
  697               ..S (RJCO DE,RJSTATU S,ENTITY)= ""
  698               ..D GETST CVAL(TYPE)                         ; EMDEON  STATUS RE CORD VALUE S FOR CLM  OR DTL
  699               ..S REJCO DES=$G(CHR JARR(IDX,J DX))
  700               ..;W:$D(T EST) !,"BL DSTC: REJC ODE STR=", REJCODES,!    ; DEBUG : ONLY OUT PUTS IF "T EST" IS DE FINED
  701               ..S RJCOD E=$P(REJCO DES,"*",1) ,RJSTATUS= $P(REJCODE S,"*",2),E NTITY=$P(R EJCODES,"* ",3)
  702               ..S REC=" "
  703               ..F LN=1: 1 S STR=$T (EMDEONSTC +LN) Q:STR ["END OF R ECORD"  D   ; GENERAT E THE STAT US (STC) R ECORD
  704               ...I LN=1  S REC=REC _$$FORMATD ATA^CHMXWB UT(STR)
  705               ...E  S R EC=REC_"|" _$$FORMATD ATA^CHMXWB UT(STR)
  706               ..W REC,!  S REC=""  S COUNT=CO UNT+1
  707               Q
  708               ;
  709   BLDTRL  ;  TRAILER RE CORD
  710               N LN,REC, STR
  711               S COUNT=C OUNT-2  ;  ADJUST COU NT FOR STA RT OF 2 (S EE EMDEON  SPEC)
  712               S (STR,LN ,REC)=""
  713               F LN=1:1  S STR=$T(E MDEONTRLR+ LN) Q:STR[ "END OF RE CORD"  D
  714               .I LN=1 S  REC=REC_$ $FORMATDAT A^CHMXWBUT (STR)
  715               .E  S REC =REC_"|"_$ $FORMATDAT A^CHMXWBUT (STR)  ; 1 0/20/2010  ADDED "ELS E"                         
  716               W REC,! S  REC=""
  717               Q
  718               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  719               ; GENERIC  FUNCTIONS  SUPPORTIN G THE RECO RD BUILDIN G                   ;
  720               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  721   GETFILE()        ;
  722               N DIRPATH ,FLAG
  723               ;HAPE POR  1/20/14 f orce FILEC NT = 1 for  all types
  724               S EICNT=0 ,FILECNT=1   ;; HAPE  POR 1/20/1 4 =FILECNT +1
  725               ;HAPE POR  1/6/14 -  if FINAL s tatus, for ce filecnt =1
  726               ;; HAPE P OR 1/20/14  I RUNTYPE ="F" S FIL ECNT=1
  727               S DIRPATH ="HAC_HFS$ :[KERMIT.W EBMD]"
  728               HANG 1  ;  POSITIVEL Y GUARANTE E NO TWO F ILES HAVE  SAME TIMES TAMP
  729               ;HAPE POR  1/6/14 -  change for  1 file pe r group
  730               I RUNTYPE ="F" S GRO UPID=""
  731               D NOW^%DT C
  732               S FMDATE= %
  733               S FMDATE= $$JUSTIFY^ CHMXWBUT(F MDATE,14,0 ,"L")
  734               S TIME=$$ JUSTIFY^CH MXWBUT($E( FMDATE,9,1 4),6,0,"L" )
  735               S DATESTA MP=($E(FMD ATE,1,7)+1 7000000)_T IME ; DATE /TIME FILE  CREATED D OWN TO SEC OND
  736               ;HAPE POR  - 11/13/1 3 GROUPID  set to dat e if not d efined.
  737               ;          - problem  with mult i-file sub mission,GR OUPID must  be the sa me value
  738               I $G(GROU PID)="" S  GROUPID=DA TESTAMP
  739               I $D(TEST ) S DIRFIL E=DIRPATH_ DATESTAMP_ "_VAHAC_"_ $S(CHMEDCO B:"COB_",1 :"")_"test .cstat"
  740               E  I CHME DCOB S DIR FILE=DIRPA TH_DATESTA MP_"_VAHAC _COB.cstat "        ;  CHMEDCOB  SET IN CHM XWT1
  741               E  S DIRF ILE=DIRPAT H_DATESTAM P_"_VAHAC. cstat"   ;  PROD FILE NAME
  742               I RUNTYPE ="H" S DIR FILE=DIRFI LE_"_H"
  743               I RUNTYPE ="O" S DIR FILE=DIRFI LE_"_O"
  744               S FLAG=$$ OFILE^CHMX WBUT(DIRFI LE,"NWS")
  745               I 'FLAG D  VMSERR Q  ""
  746               I $G(CHMX I)'="" S $ P(^CHMXCL( CHMXI,80), "^",5)=DIR FILE  ; RE CORD THE C STAT FILEN AME
  747               ;E  W !," OPENED ",D IRFILE,!
  748               Q
  749   TST     ;
  750               N FMDATE, TIME
  751               S FMDATE= 3110901.12 34
  752               W !,FMDAT E
  753               S FMDATE= $$JUSTIFY^ CHMXWBUT(F MDATE,14,0 ,"L")
  754               W !,FMDAT E
  755               S TIME=$E (FMDATE,9, 14)
  756               W !,TIME
  757               S TIME=$$ JUSTIFY^CH MXWBUT($E( FMDATE,9,1 4),6,0,"L" )
  758               W !,TIME
  759               Q
  760               ;
  761   CLOSEFILE        ;
  762               C DIRFILE
  763               Q
  764               ;
  765   GETCHCLEI( CHCLI,CHTP I)  ; BUIL D ARRAY OF  CLAIM IND ICES (CHMX CLE(I) VAL UES)
  766               ; CHCLI      I INDEX  FOR ^CHMX CL() FILE  (CLAIM FIL E RECEIVED )
  767               N STAT,CH CLAI,PDI,C HIDXS,CHCL EI,RECCNT, CTPI S CTP I=0
  768               S STAT="" ,STAT=$O(^ CHMXCLE("A ",CHCLI,ST AT)) I $D( TEST) W:ST AT="" !,"N ULL STAT"   Q:STAT=""                 ; RET RIEVE STAT US VALUE
  769               S CHCLAI= "",CHCLAI= $O(^CHMXCL E("A",CHCL I,STAT,CHC LAI)) I $D (TEST) W:C HCLAI="" ! ,"NULL CHC LAI"  Q:CH CLAI=""  ;  RETRIEVE  THE ^CHMXC LA(I) VALU E
  770               I $D(TEST ) W !,"  G ETCHCLEI:  READING:", CHCLI,"  S TATUS= ",S TAT,"  ^CH MXCLA(I)=  ",CHCLAI,"   TP= ",CT PI
  771               S STAT=""
  772               F  S STAT =$O(^CHMXC LE("A",CHC LI,STAT))  Q:STAT=""   D
  773               .S CHCLAI =""
  774               .F  S CHC LAI=$O(^CH MXCLE("A", CHCLI,STAT ,CHCLAI))  Q:CHCLAI=" "  D
  775               ..S PDI=0
  776               ..F  S PD I=$O(^CHMX CLE("A",CH CLI,STAT,C HCLAI,PDI) )  Q:'PDI   D
  777               ...S CHID XS=$O(^CHM XCLE("A",C HCLI,STAT, CHCLAI,PDI ,0))
  778               ...Q:CHID XS=""  ; P DI RETRIEV ES BUFFER  IDXs
  779               ...S CHCL EI=$P(CHID XS,"*",3)
  780               ...S ^ZSC ($J,CHTPI, CHCLEI)=ST AT,RECCNT= $I(^ZSC($J ,0))
  781               Q
  782               ;
  783   GETTP(CHA)       ;
  784               N TPID,ID
  785               S ID=""
  786               S TPID=$P ($G(^CHMXC LA(CHA,1)) ,"^",1)
  787               S:TPID]""  ID=$O(^CH MXTP("C",T PID,""))
  788               Q ID
  789               ;
  790   GETPENDEI( CHFROM,CHT O)  ; GET  CHCLEI FRO M PENDING  ^CHMPAY(I)  FROM/TO V ALUES
  791               K ^ZSC($J )
  792               N IDX,CHJ K,PDI,CHCL EI,CHCLAI, CTPI,RECCN T  S RECCN T=0
  793               F IDX=CHF ROM:1 Q:ID X>CHTO  D
  794               .S CHJK=$ O(^CHMPAY( IDX,"PDI", 0)) Q:CHJK =""
  795               .S PDI=$P (^CHMPAY(I DX,"PDI",C HJK,0),"^" ,1) Q:PDI= ""
  796               .S CHCLEI =$P($G(^CH MIMAGE(PDI ,"BUFF")), "^",6) Q:C HCLEI=""
  797               .S CHCLAI =$P($G(^CH MIMAGE(PDI ,"BUFF")), "^",3) Q:C HCLAI=""
  798               .S CTPI=$ $GETTP(CHC LAI)  ; TR ADING PART NER FOR CU RRENT CLAI M
  799               .I CHCLEI ]"" I CTPI '="",$D(CH TPARR(CTPI )) S ^ZSC( $J,CTPI,CH CLEI)="",R ECCNT=RECC NT+1
  800               S ^ZSC($J ,0)=RECCNT
  801               Q
  802               ;
  803   GETFINEI         ; HA PE POR 6/1 5/13 - GET  CHCLEI FO R FINAL CL AIM STATUS
  804               K ^ZSC($J ),^ZSC1($J )
  805               N CHCLEI, CHCLAI,CTP I,RECCNT,C LC,CLB,CHP IDX,CHPDAT E,CHPPDI,X HAC
  806               N XHACDT
  807               S RECCNT= 0
  808               ; HAPE PO R - initia l search d ate set to  today - 6  months
  809               ; HAPE PO R - 12/10/ 13 Cannot  go back an y further  than 7/27/ 13
  810               ;             this i s the date  SLLA went  live and  claims wer e processe d
  811               ; HAPE PO R - 1/7/14  (2nd rel)  change in itial look  back to o nly 12/2/1 3
  812               ;S %H=$H- 183
  813               I $H<6324 7 S CHPDAT E=3131202   ;if befor e 3/1/14 f orce start  date
  814               E  S %H=$ H-7 D YMD^ %DTC S CHP DATE=X
  815               ;SBB 03/0 6/2014 DEV 020322; Fi xed the ch eck for CS TAT final  claims.
  816               ;F  S CHP DATE=$O(^C HMPAY("E", CHPDATE))  Q:CHPDATE= ""  S CHPI DX="" F  S  CHPIDX=$O (^CHMPAY(" E",CHPDATE ,CHPIDX))  Q:CHPIDX=" "  I $G(^( CHPIDX))=" " D    
  817               F  S CHPD ATE=$O(^CH MPAY("E",C HPDATE)) Q :CHPDATE=" "  S CHPID X="" F  S  CHPIDX=$O( ^CHMPAY("E ",CHPDATE, CHPIDX)) Q :CHPIDX=""   I $P(^CH MPAY(CHPID X,10),"^", 23)="" D
  818               . S CHPPD I=$O(^CHMP AY(CHPIDX, "PDI",0))  Q:CHPPDI=" "
  819               . S CHPPD I=$P($G(^C HMPAY(CHPI DX,"PDI",C HPPDI,0)), "^")
  820               . ;HAPE P OR - if no  PDI found , skip the  claim
  821               . I CHPPD I="" Q
  822               . S CHCLE I=$Q(^CHMX CLE("PDI", CHPPDI)) I  CHCLEI=""  Q
  823               . I $P(CH CLEI,",",2 )'=CHPPDI  Q
  824               . S CHCLE I=$TR($P($ P(CHCLEI," *",2,99)," *",3),""") ","")
  825               . ;HAPE P OR - $$FIN AL returns  whether t he claim i s to be re ported as  FINAL
  826               . I $$FIN AL(CHCLEI)  D
  827               .. S CLC= $P(^CHMXCL E(CHCLEI,0 ),"^")
  828               .. S CLB= $P(^CHMXCL C(CLC,0)," ^")
  829               .. S CHCL AI=$P(^CHM XCLB(CLB,0 ),"^")
  830               .. S CTPI =$$GETTP(C HCLAI)  ;T RADING PAR TNER FOR C URRENT CLA IM
  831               .. I $D(C HTPARR(CTP I)) S ^ZSC ($J,CTPI,C HCLEI)="", RECCNT=REC CNT+1,^ZSC 1($J,CHPDA TE,CHPIDX) ="" D
  832               ... S XHA C="" F  S  XHAC=$O(^C HMXCLE(CHC LEI,80,"B" ,XHAC)) Q: XHAC=""  D
  833               .... S XH ACDT=$P($G (^CHMPAY(X HAC,0)),"^ ",10)
  834               .... I XH ACDT'="" S  ^ZSC1($J, XHACDT,XHA C)=""
  835               S ^ZSC($J ,0)=RECCNT
  836               Q
  837               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  838               ; GETCHTP I  RETURN  THE NEXT T RADING PAR TNER INDEX  BASED ON  THE LAST I NDEX   ;
  839               ; USED.   THIS FUNCT RION IS CA LLED BY TH E "PENDING  STATUS" P ROCESS.           ;
  840               ; FUNCTIO N USES LOC AL VARUIAB LE "CHTPI"  AS THE BA SIS FOR RE TURNING AL L      ;
  841               ; TRADING  PARTNER I NDICES. IF  TRADING P ARTNER IS  INACTIVE,  FUNCTION M OVES   ;
  842               ; TO THE  NEXT TRACK ING GLOBAL  TRADING P ARTNER.                                 ;
  843               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  844   GETCHTPI         ;
  845               N TRKI,CH TPI
  846               S CHTPI=" "
  847               F  S CHTP I=$O(^CHMX 277("B",CH TPI),-1) Q :CHTPI=""   D  ;TRADI NG PARTNER S FROM "B"  XREF
  848               .S TRKI=0 ,TRKI=$O(^ CHMX277("B ",CHTPI,TR KI))  ; GE T TRACKING  GLOBAL IN DEX
  849               .I ($P($G (^CHMX277( TRKI,0))," ^",3)=1) S  CHTPARR(C HTPI)=""
  850               Q
  851               ;
  852   GETCLMI(DA TE,FLAG)       ; MATC H A DATE W ITH THE ^C HMXCL(I) E NTRY             
  853               ;   DATE     DATE FO R THE ^CHM XCL() SEAR CH
  854               ;   FLAG     ">","<" ,"'<",OR " '>" DATE S EARCH POSS IBILITIES
  855               N CHCNT,L STI,EXIT,W DATE,RTN
  856               S RTN=0,E XIT=0
  857               S LSTI=($ P(^CHMXCL( 0),"^",3)) +1
  858               F CHCNT=1 :1 Q:(LSTI ="")!(EXIT )  S LSTI= $O(^CHMXCL (LSTI),-1)    D
  859               .S WDATE= $P($P($G(^ CHMXCL(LST I,0)),"^", 1),".",1)    ; FILE O PENED DATE
  860               .I ((FLAG ="<")&(WDA TE<DATE))  S RTN=LSTI ,EXIT=1      ; DATE <  SPECIFIED  DATE
  861               .E  I ((F LAG=">")&( WDATE>DATE )) S RTN=L STI,EXIT=1   ; DATE >  SPECIFIED  DATE
  862               .E  I ((F LAG="'<")& (WDATE'>DA TE)) S RTN =LSTI,EXIT =1  ; DATE  = OR > SP ECIFIED DA TE
  863               .E  I ((F LAG="'>")& (WDATE'<DA TE)) S RTN =LSTI,EXIT =1  ; DATE  < OR = SP ECIFIED DA TE
  864               Q RTN
  865               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  866               ; FILEMAN  UPDATE "D R" STRING  BUILD FUNC TION                                    ;
  867               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;    
  868   SETDARR(ST R)    ;
  869               N REG,DRD ATA,TMP,ID X,DARR
  870               S DARR="" ,DRDATA=""
  871               F IDX=1:1  S TMP=$P( STR,"^",ID X) Q:TMP=" "  D
  872               .S REG=$P (TMP,"=",1 ),VAL=$P(T MP,"=",2)
  873               .S DARR(R EG)=VAL
  874               S DRDATA= $$SETDR^CH HRLIBFM("D ARR")
  875               Q DRDATA
  876               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;
  877               ; RETRIEV E VALUES F ROM THE TR ACKING GLO BAL                                 ;
  878               ; NEEDS:  CHTPI: TRA DING PARTN ER INDEX T O USE                               ;
  879               ;         RUNTYPE:    STATUS TY PE BEING C REATED                                  ;
  880               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;   
  881   GETTOFROM( CHTPI)         ; RETR IEVE TO-FR OM FILES F ROM TRACKI NG GLOBAL
  882               N JDX,NOD E,TRKI
  883               S TRKI=0, TRKI=$O(^C HMX277("B" ,CHTPI,TRK I))  ; CON VERT CHTPI  FOR TRACK ING GLOBAL  ACCESS  
  884               S NODE=$S (RUNTYPE=" P":20,RUNT YPE="F":30 )    ; SEL ECT PENDIN G/FINAL ST ATUS NODE
  885               S JDX="A" ,JDX=$O(^C HMX277(TRK I,NODE,JDX ),-1)  ; L OOK AT LAS T ENTRY FO R THE STAT US
  886               ;W !,"GET TOFROM: CH TPI = ",CH TPI,"  NOD E= ",NODE, "  JDX= ", JDX
  887               Q:JDX=""
  888               S CHFROM= ($P($G(^CH MX277(TRKI ,NODE,JDX, 0)),"^",4) )  ; NEW " FROM"= OLD  "TO"
  889               S:CHFROM' =0 CHFROM= CHFROM+1,C HTO=$P($G( ^CHMPAY(0) ),"^",3)   ; SET STAR T/ END IND EX
  890               ;W !,"GET TOFROM: FR OM= ",CHFR OM,"  TO=  ",CHTO
  891               Q
  892               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  893               ; SUPPORT  FUNCTIONS  FOR THE F ILE GENERA TION FUNCT IONS DEFIN ED ABOVE.              ;
  894               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  895   DATERANGE( FROM,TO)       ;Promp t for a FR OM and TO  date range .
  896               N MAXTO
  897               D NOW^%DT C S MAXTO= $E(%,1,7)
  898               S (FROM,T O)="",(DON E,POP)=0
  899               F  Q:(DON E)!(POP)   D
  900               .S FROM=$ $GETDATE^C HMXWBUT("E NTER START  DATE: ")  S:FROM=-1  POP=1 Q:PO
  901               .I ((FROM <1)!(FROM> MAXTO)) W  " [Invalid  date. Try  again]" Q
  902               .S TO=$$G ETDATE^CHM XWBUT("ENT ER END DAT E: ") S:TO =-1 POP=1  Q:POP
  903               .I ((TO<F ROM)!(TO>M AXTO)) W "  [Invalid  date. Try  again]" Q
  904               .S DONE=1
  905               Q POP
  906   GETSTVAL(C HCLEI)         ; REVE RSE POLISH  METHOD FO R RETRIEVI NG CLAIM S TATUS
  907               N CHCLCI, CHCLBI,CHC LAI,CHCLI, TARGEI,STA T,PDI
  908               S CHCLCI= $P(^CHMXCL E(CHCLEI,0 ),"^",1)   ;TRAVERSE  BACK THROU GH BUFFER  FILES
  909               S CHCLBI= $P(^CHMXCL C(CHCLCI,0 ),"^",1)
  910               S CHCLAI= $P(^CHMXCL B(CHCLBI,0 ),"^",1)
  911               S CHCLI=$ P(^CHMXCLA (CHCLAI,0) ,"^",1)
  912               S PDI=$P( ^CHMXCLE(C HCLEI,100) ,"^",2)
  913               S:PDI=""  PDI=$P(^CH MXCLE(CHCL EI,100),"^ ",4)
  914               I PDI=""  Q 6  ;Assu me 6 that  it was rej ected if n o PDI foun d...data i ntegrity i ssue
  915               S STAT=0, TARGEI=0
  916               F  Q:TARG EI=CHCLEI   D
  917               .S STAT=$ O(^CHMXCLE ("A",CHCLI ,STAT))
  918               .S CHIDXS =0,CHIDXS= $O(^CHMXCL E("A",CHCL I,STAT,CHC LAI,PDI,"" ))
  919               .S TARGEI =$P(CHIDXS ,"*",3)
  920               Q STAT
  921               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;
  922               ; EMAIL S TATUS TO I NTERESTED  PARTIES                                             ;
  923               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;         
  924   AUTOMM(TYP E)     
  925               D NOW^%DT C
  926               S FMDATE= $E(%,1,7)
  927               S CHNB=2, ZML(CHNB)= "",ZML(CHN B)=CHVMSFL _"  (Total  Records =  "_CHBRCCN T_")"
  928               S CHNB=CH NB+1,ZML(C HNB)=""
  929               I TYPE="E FILE"  S C HNB=CHNB+1 ,ZML(CHNB) ="NOTICE:  ***ERROR** * CREATING  277U STAT  file!"
  930               E  I TYPE ="OK" S CH NB=CHNB+1, ZML(CHNB)= "NOTICE: S uccessful  CREATION 2 77U STAT f ile!"
  931               S CHNB=CH NB+1,ZML(C HNB)="EDI  BATCH NUMB ER ^CHMXCL ("_CHMXI_" ,0)"
  932               S XMTEXT= "ZML(",XMS UB="277U W ebMD..Succ ess.."_FMD ATE
  933               S XMDUZ=. 5
  934               S XMY("27 4577")="", XMY("24618 3")=""
  935                S XMY(" PII                   ")=""
  936                S XMY("
P II                   ")=""
  937               D ^XMD
  938               Q
  939               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  940               ; THE FOL LOWING ROU TINES ARE  PRESERVED  FOR HISTOR ICAL PURPO SES                        ;
  941               ; THERE A RE COPIES  OF THESE F UNCTIONS I N CHMXWB07 ,CHMXWB11, CHMXWB21                   ;
  942               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;; 
  943               ;
  944   EXFTP   S  CHFTPMSG=0
  945               ;H 1000 ; DEF4399 aj m removed  hang, not  needed
  946   XCOM    S  X=$ZF(-1," SUBMIT HAC _HFS$:[DSM MANAG]WEB_ WS_FTP.COM  /NAME=WEB _WS_FTP_JO B/NOPRINTE R/USER=HAC CACHEMGR/P ARAM="_CHF ILE)
  947               ;//////// //// UNREM ARK/REMARK  OUT CODE  FOR PRODUC TION ///// /////
  948               ;H 1200 ; DEF4399 aj m removed  hang, not  needed
  949               K ^CHMZHO LD("RKN_W2 77")
  950               Q  ;DEF43 99 ajm add d - files  are copied , no longe r ftp'd
  951               ;
  952   FTPCK   S  RD="HAC_HF S$:[DSMMAN AG]WEB_WS_ FTP_JOB.LO G"    ;LIV E
  953               ;C RD
  954               K CHFTPTI M,CHFTPWT  S ZE="",QF LAG=0,CHFT PWT=$P(^CH MDIC(74100 2.17,1,2), "^",10)
  955               F CHFTPTI M=1:1:CHFT PWT H 60
  956               O RD:"R"  D  Q:(QFLA G=1)    ;R KN, 6-29-0 5, MOD REA DONLY
  957               .I '$T C  RD Q
  958               .F  U RD  R RDLINE   D  Q:(QFLA G=1)!($ZE[ "ENDOFILE" )
  959               ..I (RDLI NE["226 Tr ansfer com plete") S  CHFTPMSG=1 ,QFLAG=1 Q
  960               ..I (RDLI NE["Charge d CPU time :") S QFLA G=1 Q
  961   FTPERR;
  962               C RD 
  963               S CHNB=2
  964               S ZML(CHN B)=""
  965               S ZML(CHN B)=CHVMSFL
  966               S CHNB=CH NB+1
  967               S ZML(CHN B)=""
  968               S CHNB=CH NB+1
  969               S XMTEXT= "ZML("
  970               K CHFTPMS G,RD,RDLIN E
  971               ;
  972               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  973               ; CALCULA TE A DATE  90 DAYS IN  THE PAST                                          ;
  974               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;
  975   DOLDFLS D  NOW^%DTC
  976               S X1=X,X2 =-90
  977               D C^%DTC
  978               D YX^%DTC
  979               Q
  980               ;
  981               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  982               ; Error H andler / p ersonnel n otificatio n function s for the  277 status  file           ;
  983               ; generat ion proces s.                                                                     ;
  984               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  985               ;
  986   VMSERR  ;
  987               I $G(IO)' ="" C IO       
  988               D ^%ZTER
  989               ;
  990   ERRMM   ;
  991               ;S CHERRM SG=1,CHNB= 2,ZML(CHNB )="",ZML(C HNB)=CHVMS FL,CHNB=CH NB+1,ZML(C HNB)="",CH NB=CHNB+1
  992               ;S ZML(CH NB)="NOTIC E: An erro r has occu rred in wr iting Upda te for the ",CHNB=CHN B+1
  993               ;S ZML(CH NB)=" 277U  WebMD fil e!"
  994               ;S XMDUZ= .5,XMY("10 722")="" ; RKN LIVE
  995               ;S XMTEXT ="ZML(",XM SUB="277U  WebMD..Err or.."_FMDA TE
  996               S CHERRMS G=1,CHNB=2 ,ZML(CHNB) ="",ZML(CH NB)=$G(CHV MSFL),CHNB =CHNB+1,ZM L(CHNB)="" ,CHNB=CHNB +1
  997               S ZML(CHN B)="NOTICE : An error  has occur red in wri ting Updat e for the" ,CHNB=CHNB +1
  998               S ZML(CHN B)=" CSTAT  file!"
  999                ;S XMDUZ=. 5,XMY(" PII                    ")="" ;RKN  LIVE
  1000               ;S XMY(" PII                               ")= ""
  1001               S XMDUZ=. 5,XMY("274 577")="",X MY("246183 ")=""
  1002                S XMY(" PII                   ")="",XMY( "
P II                   ")=""
  1003               S XMTEXT= "ZML(",XMS UB="277U.. Error.."_D ATESTAMP
  1004               ; BAS -EN D MOD
  1005               D ^XMD
  1006               Q
  1007               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  1008               ; $TEXT V ARIABLE SE TUP ROUTIN ES                                                          ;
  1009               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  1010   GETHDRVAL        ;
  1011               ;HAPE POR  - 6/1/13  added Payn ame and Pa yphone val ues for Fi nal
  1012               ;     cla im status
  1013               ;HAPE POR  9/24/13 -  add abili ty to gene rated a FU LL load ty pe for ini tial run
  1014               S LOADTYP E=$S(RUNTY PE="H":"F" ,$G(FULL)= 1:"F",1:"I ")
  1015               S (PAYNAM E,PAYPHONE )=""
  1016               I RUNTYPE ="F" S PAY NAME="CHAM PVA CUSTOM ER SERVICE ",PAYPHONE ="80073383 87"
  1017               Q
  1018               ;
  1019   GETCLMVAL        ;
  1020               N CHCLB0, CHCLB1,CHC LC0,CHMPAY 1,CHCLE64, CHCLB0A,CL MTYP
  1021               N TMPDTE, HACCHRG
  1022               S TMPDTE= 0
  1023               S CHCLB0= $G(^CHMXCL B(CHCLBI,0 ))
  1024               S CHCLB1= $G(^CHMXCL B(CHCLBI,1 ))
  1025               S CHCLE64 =$G(^CHMXC LE(CHCLEI, 64))
  1026               S:RUNTYPE ="F" CHMPA Y1=$G(^CHM PAY(CHMPAY I,"COMMON" ))
  1027               S BPFTI=$ P(CHCLB0," ^",2)        ; 5.BILL ING PROVID ER FEDERAL  TAX ID
  1028               S BPPN=""                         ; 6.BILL ING PROVID ER PAYER N UMBER
  1029               S BPNID=$ P(CHCLB0," ^",13)       ; 7.BILL ING PROVID ER NATIONA L ID
  1030               I RUNTYPE ="F" D
  1031               . S CHCLB 0A=$G(^CHM XCLB(CHCLB I,.1))
  1032               . S BPLNA ME=$P(CHCL B0A,"^")     ; 8.BILL ING PROVID ER LAST NA ME
  1033               . I BPLNA ME="",$P(C HCLB0,"^", 3)'="" S B PLNAME=$P( CHCLB0,"^" ,3)
  1034               . S BPFNA ME=$P(CHCL B0A,"^",2)   ; 9.BILL ING PROVID ER FIRST N AME
  1035               . S BPMNA ME=$P(CHCL B0A,"^",3)   ; 10.BIL LING PROVI DER MIDDLE  NAME
  1036               E  D
  1037               . S BPLNA ME=$P(CHCL B0,"^",3)    ; 8.BILL ING PROVID ER LAST NA ME
  1038               . S BPFNA ME=""                   ; 9.BILL ING PROVID ER FIRST N AME
  1039               . S BPMNA ME=""                   ; 10.BIL LING PROVI DER MIDDLE  NAME
  1040               S BPNAMEX =""                     ; 11.BIL LING PROVI DER NAME S UFFIX
  1041               S SPFTID= ""                      ; 12.SER VICE PROVI DER FEDERA L TAX ID
  1042               S SPPN=""                         ; 13.SER VICE PROVI DER PAYER  NUMBER
  1043               S SPNID=$ P(CHCLE64, "^",4)       ; 14.SER VICE PROVI DER NATION AL ID
  1044               S SPLNAME =$P(CHCLE6 4,"^",1)     ; 15.SER VICE PROVI DER NAME
  1045               S SPFNAME =$P(CHCLE6 4,"^",2)     ; 16.SER VICE PROVI DER FNAME
  1046               S SPMNAME =$P(CHCLE6 4,"^",3)     ; 17.SER VICE PROVI DER MNAME
  1047               S SPNAMEX =""                     ; 18.SER VICE PROVI DER NAME S UFFIX
  1048               S EMPIDNU M=""                    ; 19.EMP LOYER IDEN TIFICATION  NUMBER
  1049               S EMPNAME =""                     ; 20.EMP LOYER NAME
  1050               S CHCLC0= $G(^CHMXCL C(CHCLCI,0 ))
  1051               S SUBSCID =$P(CHCLC0 ,"^",4)      ; 21.SUB SCRIBER ID
  1052               S SUBLNAM E=$P(CHCLC 0,"^",5)     ; 22.SUB SCRIBER LA ST NAME
  1053               S SUBFNAM E=$P(CHCLC 0,"^",6)     ; 23.SUB SCRIBER FI RST NAME
  1054               S SUBMNAM E=$P(CHCLC 0,"^",7)     ; 24.SUB SCRIBER MI DDLE NAME 
  1055               S SUBNAME X=$P(CHCLC 0,"^",8)     ; 25.SUB SCRIBER NA ME SUFFIX
  1056               S PATID=" "                       ; 26.PAT IENT ID
  1057               S PATLNAM E=$P(CHCLC 0,"^",5)     ; 27.PAT IENT LAST  NAME
  1058               S PATFNAM E=$P(CHCLC 0,"^",6)     ; 28.PAT IENT FIRST  NAME
  1059               S PATMNAM E=$P(CHCLC 0,"^",7)     ; 29.PAT IENT MIDDL E NAME
  1060               S PATNAME X=$P(CHCLC 0,"^",8)     ; 30.PAT IENT NAME  SUFFIX
  1061               S PATDOB= $P(CHCLC0, "^",9)       ; 31.PAT IENT DATE  OF BIRTH  
  1062               S PATGEND R=$P(CHCLC 0,"^",10)    ; 32.PAT IENT GENDE R
  1063               S:"MF"'[P ATGENDR PA TGENDR=""    ;   DO N OT ALLOW P ATIENT GEN DER UNKNOW N
  1064               S ECLMNUM =$P(^CHMXC LE(CHCLEI, 3),"^",5)   ; 33.EMDE ON CLAIM N UMBER
  1065               S CLMCHRG =$S($P(^CH MXCLE(CHCL EI,2),"^", 1)'>0:"0.0 0",1:$P(^C HMXCLE(CHC LEI,2),"^" ,1)) ; 34. CHARGE AMT  
  1066               ;; HAPE P OR - 7/8/1 3 added be low to det ermine pay ment amoun t
  1067               I RUNTYPE ="F" D
  1068               . N HACCL M,HACLNCG
  1069               . S (HACC LM,CLMPMT) ="" F  S H ACCLM=$O(^ CHMXCLE(CH CLEI,80,"B ",HACCLM))  Q:HACCLM= ""  D
  1070               .. S HACL NCG=$G(HAC LNCG)+$$HA CLN^CHMXWB 24(HACCLM)
  1071               .. S HACC HRG=$G(HAC CHRG)+$P($ G(^CHMPAY( HACCLM,"CO MMON")),"^ ")
  1072               .. I '$D( ^CHMSNA(74 1008.2,"AB ",HACCLM)) ,'$D(^CHMS NA(741008. 3,"D",HACC LM)) S CLM PMT=0 Q
  1073               .. ;HAPE  POR 7/29/1 3 PROVIDER  PAYMENT A MOUNT
  1074               .. S CLMP MT=CLMPMT+ $P($G(^CHM PAY(HACCLM ,1)),"^",1 4)
  1075               . ; HAPE  POR 8/7/13  - if the  CLMCHRG is  different  from 'COM MON' node,  use 'COMM ON' value
  1076               . I $FN(H ACCHRG,"", 2)'=$FN(CL MCHRG,"",2 ) D
  1077               .. I HACC HRG=(2*CLM CHRG) Q
  1078               .. S CLMC HRG=HACCHR G
  1079               . I HACLN CG'="NONE" ,$FN(HACLN CG,"",2)'= $FN(CLMCHR G,"",2) D
  1080               .. I HACL NCG=(2*CLM CHRG) Q
  1081               .. S CLMC HRG=HACLNC G
  1082               E  S CLMP MT=0                    ; 35.CLA IM PAYMENT  AMOUNT
  1083               S CLMCHRG =$FN(CLMCH RG,"",2)
  1084               S CLMPMT= $FN(CLMPMT ,"",2)
  1085               S CAPD=$S (RUNTYPE=" F":PAYDATE ,1:"")  ;  36.CLAIM A DJ/PAYMENT  DATE
  1086               S CHKEFTD ATE=$S(RUN TYPE="F":C HKDATE,1:" ")  ; 37.C HECK/EFT D ATE
  1087               S CHKEFTN UM=$S(RUNT YPE="F":CH KEFT,1:"")  ; 38.CHEC K/EFT NUMB ER   
  1088               S BTYPE=$ S(RUNTYPE= "F":$P($G( ^CHMPAY(CH MPAYI,7)), "^",6),1:" ")      ;  39.BILL TY PE 
  1089               S PCIDNUM =$P($G(^CH MXCLE(CHCL EI,100))," ^",2)  ; 4 0.PAYER CL AIM ID NUM BER (PDI)
  1090               S:PCIDNUM ="" PCIDNU M=$P($G(^C HMXCLE(CHC LEI,100)), "^",4) ; P DI NOT POP ULATED, DE RIVED CLAI M CTL NUM
  1091               S PATACCT =$P($G(^CH MXCLE(CHCL EI,0)),"^" ,2)    ; 4 1.PATIENT  ACCOUNT NU MBER 
  1092               S PRSCNUM =""                     ; 42.PHA RMACY PRES CRIPTION N UMBER
  1093               S VOUCHID =""                     ; 43.VOU CHER IDENT IFIER 
  1094               S LOCSYSI D=""                    ; 44.APP /LOCATION  SYSTEM ID
  1095               S GRPNUM= ""                      ; 45.GRO UP NUMBER
  1096               S CLMTYP= $$GETCLMTY P            ; GET I/ P/D CLAIM  TYPE
  1097               S:CLMTYP= "P" SVCDAT ES=$$GPSTA RTEND  ; 4 6/47. PROF ESSIONAL S ERVICE STA RT DATE
  1098               S:CLMTYP= "I" SVCDAT ES=$$GISTA RTEND  ; 4 6.1/47.1 I NSTITUTION AL START/E ND
  1099               S:CLMTYP= "D" SVCDAT ES=$$GDSTA RTEND  ; 4 6.2/47.2 D ENTAL STAR T/END
  1100               S CLMSTDT =$P(SVCDAT ES,"*",1), CLMENDT=$P (SVCDATES, "*",2)
  1101               Q
  1102               ;
  1103   GPSTARTEND ()    ; PO PULATE EMD EON REQUIR ED FIELD F OR PROFESS IONAL CLAI M START/EN D DATES
  1104               N STDATE, CHFI,TDATE ,EDATE,SVC DATES
  1105               S CHFI=0
  1106               S CHFI=$O (^CHMXCLF( "B",CHCLEI ,CHFI))
  1107               S STDATE= $P($G(^CHM XCLF(CHFI, 1)),"^",11 ),TMPDTE=S TDATE  ; T MPDTE IS L AST START  DATE
  1108               F  S CHFI =$O(^CHMXC LF("B",CHC LEI,CHFI))  Q:'CHFI   D  ; CHECK  ALL LI "F ROM" DATES
  1109               .S TDATE= $P($G(^CHM XCLF(CHFI, 1)),"^",11 )
  1110               .I TDATE< STDATE S S TDATE=TDAT E   ; TRAC K "OLDEST"  START DAT E
  1111               .I TDATE> TMPDTE S T MPDTE=TDAT E   ; TRAC K "MOST RE CENT" STAR T DATE
  1112               S EDATE=$ $GSVCEND
  1113               S:(EDATE= "")!(EDATE <TMPDTE) E DATE=TMPDT E
  1114               ;HAPE POR  - 11/13/1 3 EDATE mu st have a  value
  1115               I EDATE=" " S EDATE= STDATE
  1116               ;HAPE POR  - 11/13/1 3 some dat a is in Fi leMan form at, needs  to be YYYY MMDD
  1117               I $L(STDA TE)=7 S X= STDATE D H ^%DTC I %H '="" S STD ATE=$ZD(%H ,8)
  1118               I $L(EDAT E)=7 S X=E DATE D H^% DTC I %H'= "" S EDATE =$ZD(%H,8)
  1119               S SVCDATE S=STDATE_" *"_EDATE
  1120               Q SVCDATE S
  1121               ;
  1122   GISTARTEND ()    ; PO PULATE EMD EON FIELD  FOR INSTIT UTIONAL CL AIM START/ END DATES
  1123               N STDATE, CHFI,TDATE ,EDATE,SVC DATES
  1124               S CHFI=0
  1125               S STDATE= $P($G(^CHM XCLE(CHCLE I,1)),"^", 1)   ; STA RT DATE
  1126               S EDATE=$ P($G(^CHMX CLE(CHCLEI ,1)),"^",2 )    ; END  DATE
  1127               ;HAPE POR  - 11/13/1 3 EDATE mu st have a  value
  1128               I EDATE=" " S EDATE= STDATE
  1129               ;HAPE POR  - 11/13/1 3 some dat a is in Fi leMan form at, needs  to be YYYY MMDD
  1130               I $L(STDA TE)=7 S X= STDATE D H ^%DTC I %H '="" S STD ATE=$ZD(%H ,8)
  1131               I $L(EDAT E)=7 S X=E DATE D H^% DTC I %H'= "" S EDATE =$ZD(%H,8)
  1132               S SVCDATE S=STDATE_" *"_EDATE
  1133               Q SVCDATE S
  1134               ;
  1135   GDSTARTEND ()    ; PO PULATE EMD EON FIELD  FOR DENTAL  CLAIM STA RT/END DAT ES
  1136               N STDATE, EDATE,SVCD ATES
  1137               S STDATE= $P($G(^CHM XCLE(CHCLE I,1)),"^", 1)   ; STA RT DATE
  1138               S EDATE=$ P($G(^CHMX CLE(CHCLEI ,1)),"^",2 )    ; END  DATE
  1139               ;HAPE POR  - 11/13/1 3 EDATE mu st have a  value
  1140               I EDATE=" " S EDATE= STDATE
  1141               ;HAPE POR  - 11/13/1 3 some dat a is in Fi leMan form at, needs  to be YYYY MMDD
  1142               I $L(STDA TE)=7 S X= STDATE D H ^%DTC I %H '="" S STD ATE=$ZD(%H ,8)
  1143               I $L(EDAT E)=7 S X=E DATE D H^% DTC I %H'= "" S EDATE =$ZD(%H,8)
  1144               S SVCDATE S=STDATE_" *"_EDATE
  1145               Q SVCDATE S
  1146               ;
  1147   GETSTCVAL( TYPE) ;
  1148               S PCINUM= $P($G(^CHM XCLE(CHCLE I,100)),"^ ",2)    ;  4.PAYER CL AIM ID NUM BER(PDI)  
  1149               S:PCINUM= "" PCINUM= $P($G(^CHM XCLE(CHCLE I,100)),"^ ",4)  ; PD I NOT POPU LATED, DER IVED CLAIM  CTL NUM
  1150               S DATERR= ""   ;10.E MDEON SPEC IFIC DATA  IN ERROR
  1151               S ESCODE= ""   ;11.E MDEOM SPEC IFIC STATU S CODE
  1152               I RUNTYPE ="F" D  Q
  1153               . I TYPE= "CLM" S LI CNUM="" Q
  1154               . I CHCLF I="" S LIC NUM=$G(STC LICN) Q
  1155               . I $P($G (^CHMXCLF( CHCLFI,1)) ,"^",23)'= "" S LICNU M=$P(^(1), "^",23)
  1156               . I $G(LI CNUM)="" S  LICNUM=$P ($G(^CHMXC LF(CHCLFI, 0)),"^",2)
  1157               S:TYPE="C LM" LICNUM =""                           ;  5.CLM LVL  LINE ITEM  CONTROL NU MBER
  1158               S:TYPE="D TL" LICNUM =$P($G(^CH MXCLF(CHCL FI,0)),"^" ,2)   ;    SERVICE LI NE NUMBER 
  1159               Q
  1160               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  1161               ; 9/7/201 1: modifie d Procedur e Modifier  #1 extrac t to field  4 from fi eld 3;
  1162               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  1163   GDTLVARS         ; DT L RECORD D ATA GATHER ING
  1164               N TOC,CLT YPE,CLLD0, CLLD1,X1,X 2,CHCLF1,C LMTYP,CLNU M,SVCDATES ,PIECE
  1165               S (TOC,CL TYPE,LICN, CLLD0,CLLD 1)=""
  1166               S PCID=$P ($G(^CHMXC LE(CHCLEI, 100)),"^", 2)          ; FIRST T RY THE ASS IGNED PDI  NUMBER
  1167               S:PCID=""  PCID=$P($ G(^CHMXCLE (CHCLEI,10 0)),"^",4)  ; PDI NOT  POPULATED , DERIVED  CLAIM CTL  NUM
  1168               S CHCLF1= $G(^CHMXCL F(CHCLFI,1 ))
  1169               ; HAPE PO R - set TO C = type o f claim
  1170               I RUNTYPE ="F" D
  1171               . S CLNUM =$P($G(^CH MXCLF(CHCL FI,0)),"^" ,2)
  1172               . S HACCL M=$O(LNDAT A(CLNUM,"" ))
  1173               . I HACCL M'="" S TO C=$$TOS^CH 835FU1($P( $G(^CHMPAY (HACCLM,0) ),"^",7))
  1174               . I $G(TO C)'="" S C LTYPE=$S(T OC="IPT":" INP-REV",T OC="OPT":" OPT-PROC", TOC="RXT": "PHARM",TO C="DUR":"D ME-SUPPLY" ,TOC="DNT" :"DEN-PROC ",TOC="TRV ":"OPT-PRO C",1:"OPT- PROC")
  1175               . I HACCL M'="" S CL LD1=$G(^CH MPAY(HACCL M,1))
  1176               . I $P($G (^CHMXCLF( CHCLFI,1)) ,"^",23)'= "" S LICN= $P(^(1),"^ ",23)
  1177               . Q
  1178               I LICN=""  S LICN=$P ($G(^CHMXC LF(CHCLFI, 0)),"^",2)   ; 5.SERV ICE LINE N UMBER
  1179               S SQID=$P (CHCLF1,"^ ",2)  ; 6. SERVICE QU ALIFIER ID
  1180               S:SQID=""  SQID="NU"       ;     DEFAULT V ALUE IF NO T PROVIDED
  1181               S SICODE= $P(CHCLF1, "^",3)  ;  7.SERVICE  IDENTIFICA TION CODE
  1182               S:SICODE= "" SICODE= $P(^CHMXCL F(CHCLFI,1 ),"^",1)   ;DEFAULT V ALUE IF NO T PROVIDED
  1183               S PRCM1=$ P(CHCLF1," ^",4)  ; 8 .PROCEDURE  MODIFIER  1
  1184               S PRCM2=$ P(CHCLF1," ^",5)  ; 9 .PROCEDURE  MODIFIER  2
  1185               S PRCM3=$ P(CHCLF1," ^",14)  ;  10.PROCEDU RE MODIFIE R 3
  1186               S PRCM4=$ P(CHCLF1," ^",15)  ;  11.PROCEDU RE MODIFIE R 4
  1187               I RUNTYPE ="F" D
  1188               . N X
  1189               . S LICHR GA=$$LCA(T OC,CLNUM,C HCLF1,HACC LM,.LNDATA )  ;FINAL  LINE ITEM  CHARGE AMO UNT
  1190               . S:LICHR GA="" LICH RGA=$P(CHC LF1,"^",6)  S LICHRGA =$FN(LICHR GA,"",2)
  1191               . ;HAPE P OR - 7/8/1 3 added $$ LPA for FI NAL line p ayment amo unt
  1192               . S LIPPA =$FN($$LPA (TOC,CLNUM ,CHCLFI,HA CCLM,CLTYP E,.LNDATA) ,"",2)  ;F INAL LINE  ITEM PROV.  PAYMENT A MOUNT
  1193               . S QTYUO S=$$LQTY(T OC,CLNUM,C HCLF1,HACC LM,.LNDATA )  ;FINAL  QUANTITY(U NITS OF SE RVICE)
  1194               . S PIECE =$S(TOC="D NT":10,TOC ="DUR":8,T OC="IPT":1 ,TOC="OPT" :16,TOC="R XT":0,TOC= "TRV":16,1 :0)
  1195               . I HACCL M="" S RVN UCODE="" Q
  1196               . S X=$O( LNDATA(CLN UM,HACCLM, "")) I X=" " S RVNUCO DE="" Q
  1197               . S RVNUC ODE=$P($G( LNDATA(CLN UM,HACCLM, X)),"^",PI ECE) I RVN UCODE'=""  S RVNUCODE =$$REVCD^C HMXWB24(RV NUCODE)
  1198               . ;HAPE P OR 12/20/1 3 - proble m with Ser vice Ident ification  Code when  Service Qu alifer ID  = NU
  1199               . ;HAPE P OR 1/20/14  - made ch ange to fo rce revenu e code = " " when ser vice quali fer id = N U and serv ice identi fication
  1200               . ;                     code is  set = rev enue code
  1201               . I SQID= "NU" S SIC ODE=RVNUCO DE,RVNUCOD E=""
  1202               I RUNTYPE '="F" D
  1203               . S LICHR GA=$P(CHCL F1,"^",6)   ; 12.ACK/ PEND LINE  ITEM CHARG E AMOUNT
  1204               . S LIPPA ="0.00"  ;  13.ACK/PE ND LINE IT EM PROV. P AYMENT AMO UNT
  1205               . S RVNUC ODE=$P(^CH MXCLF(CHCL FI,1),"^")  ; 14.REVE NUE CODE
  1206               . S QTYUO S=$P(CHCLF 1,"^",8)   ; 15.ACK/P END QUANTI TY(UNITS O F SERVICE)
  1207               I RVNUCOD E="9999" S  RVNUCODE= ""          ;    DON' T OUTPUT 9 999 VALUE
  1208               S ECLMNUM =$P(^CHMXC LE(CHCLEI, 3),"^",5)   ; 16.EMDE ON CLAIM N UMBER
  1209               S CLMTYP= $$GETCLMTY P   ; GET  I/P/D CLAI M TYPE
  1210               S:CLMTYP= "P" SVCDAT ES=$$GPDST ARTEND  ;  17. PROFES SIONAL SER VICE START /END DATE
  1211               S:CLMTYP= "I" SVCDAT ES=$$GIDST ARTEND  ;  17.1 INSTI TUTIONAL S ERVICE STA RT/END DAT ES
  1212               S:CLMTYP= "D" SVCDAT ES=$$GDDST ARTEND  ;  17.2 DENTA L SERVICE  START/END  DATES
  1213               S SVCSTDA TE=$P(SVCD ATES,"*",1 ),SVCENDAT E=$P(SVCDA TES,"*",2)
  1214               Q
  1215               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  1216               ; LINE IT EM FUNCTIO NS TO GATH ER THE SPE CIFIC DATA  FIELDS             ;
  1217               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  1218               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  1219               ; EMDEON  REQUIRES T HE EARLIES T START DA TE (CLAIM  OR LINE IT EM DATE  ;
  1220               ; FOR THE  SERVICE S TART DATE.  THIS FUNC TION 1) GE TS THE CLA IM START ;
  1221               ; DATE, T HEN SEARCH ES THROUGH  LINE ITEM S FOR ANY  EARLIER DA TES.     ;
  1222               ; THE EAR LIEST DATE  FOUND IS  RECORDED A S THE STAR T DATE.             ;
  1223               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  1224               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  1225               ; DETERMI NE THE CLA IM TYPE, I .E. PROFES SIONAL, IN STITUTIONA L, OR DENT AL
  1226               ; 4010/50 10 VERSION  IDENTIFIE RS
  1227               ;  98 / 2 22 PROFESS IONAL CLAI MS
  1228               ;  96 / 2 23 INSTITU TIONAL CLA IMS
  1229               ;  97 / 2 24 DENTAL  CLAIMS
  1230               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  1231   GETCLMTYP( )     ;
  1232               N TYPE  ;  VERSION-F UNCTIONAL  TYPE NUMBE R FROM ^CH MXCLA()
  1233               S TYPE=$P ($G(^CHMXC LA(CHCLAI, 0)),"^",13 )
  1234               Q:(TYPE[2 22)!(TYPE[ 98) "P"
  1235               Q:(TYPE[2 23)!(TYPE[ 96) "I"
  1236               Q:(TYPE[2 24)!(TYPE[ 97) "D"
  1237               Q "U"
  1238               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  1239               ; PROFESS IONAL STAR T/END DATE S
  1240               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;
  1241   GPDSTARTEN D()   ; PO PULATE EMD EON REQUIR ED FIELD F OR PROFESS IONAL STAR T/END DATE S
  1242               N STDATE, CHFI,TDATE ,EDATE,SVC DATES
  1243               S STDATE= $P($G(^CHM XCLF(CHCLF I,1)),"^", 11)  ; STA RT DATE
  1244               S EDATE=$ P($G(^CHMX CLF(CHCLFI ,1)),"^",1 2)   ; END  DATE
  1245               S:EDATE=" " EDATE=ST DATE
  1246               ;HAPE POR  - 11/13/1 3 some dat a is in Fi leMan form at, needs  to be YYYY MMDD
  1247               I $L(STDA TE)=7 S X= STDATE D H ^%DTC I %H '="" S STD ATE=$ZD(%H ,8)
  1248               I $L(EDAT E)=7 S X=E DATE D H^% DTC I %H'= "" S EDATE =$ZD(%H,8)
  1249               S SVCDATE S=STDATE_" *"_EDATE
  1250               Q SVCDATE S
  1251               ;
  1252   GIDSTARTEN D()   ; PO PULATE EMD EON FIELD  FOR INSTIT UTIONAL DE TAIL START /END DATES
  1253               N STDATE, CHFI,TDATE ,EDATE,SVC DATES
  1254               S STDATE= $P($G(^CHM XCLF(CHCLF I,1)),"^", 11)
  1255               S:STDATE= "" STDATE= $P($G(^CHM XCLE(CHCLE I,1)),"^", 1) ; START  DATE
  1256               S EDATE=$ P($G(^CHMX CLF(CHCLFI ,1)),"^",1 2)
  1257               S:EDATE=" " EDATE=$P ($G(^CHMXC LF(CHCLFI, 1)),"^",11 )
  1258               S:EDATE=" " EDATE=$P ($G(^CHMXC LE(CHCLEI, 1)),"^",2)
  1259               I EDATE=" " S EDATE= STDATE  ;H APE POR -  11/13/13 m ake sure e nd date is  sent
  1260               ;HAPE POR  - 11/13/1 3 some dat a is in Fi leMan form at, needs  to be YYYY MMDD
  1261               I $L(STDA TE)=7 S X= STDATE D H ^%DTC I %H '="" S STD ATE=$ZD(%H ,8)
  1262               I $L(EDAT E)=7 S X=E DATE D H^% DTC I %H'= "" S EDATE =$ZD(%H,8)
  1263               S SVCDATE S=STDATE_" *"_EDATE
  1264               Q SVCDATE S
  1265               ;
  1266   GDDSTARTEN D()   ; EM DEON DENTA L DETAIL S TART/END D ATES
  1267               N STDATE, CHFI,TDATE ,EDATE,SVC DATES
  1268               S STDATE= $P($G(^CHM XCLF(CHCLF I,1)),"^", 11)  ; STA RT DATE
  1269               S EDATE=$ P($G(^CHMX CLF(CHCLFI ,1)),"^",1 2)   ; END  DATE
  1270               S:EDATE=" " EDATE=ST DATE
  1271               ;HAPE POR  - 11/13/1 3 some dat a is in Fi leMan form at, needs  to be YYYY MMDD
  1272               I $L(STDA TE)=7 S X= STDATE D H ^%DTC I %H '="" S STD ATE=$ZD(%H ,8)
  1273               I $L(EDAT E)=7 S X=E DATE D H^% DTC I %H'= "" S EDATE =$ZD(%H,8)
  1274               S SVCDATE S=STDATE_" *"_EDATE
  1275               Q SVCDATE S
  1276               ;
  1277               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  1278               ; EMDEON  REQUIRES T HE LAST EN D DATE (CL AIM OR LIN E ITEM DAT E        ;
  1279               ; FOR THE  SERVICE E ND DATE. T HIS FUNCTI ON 1) GETS  THE CLAIM  START   ;
  1280               ; DATE, T HEN 2)SEAR CHES THROU GH LINE IT EMS FOR AN Y LATER DA TES.     ;
  1281               ; THE LAT EST DATE F OUND IS RE CORDED AS  THE END DA TE.                 ;
  1282               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  1283               ;
  1284   GSVCEND()        ; PO PULATE EMD EON REQUIR ED FIELD F OR SERVICE  END DATE
  1285               N ENDATE, CHFI,TDATE
  1286               S CHFI=0, CHFI=$O(^C HMXCLF("B" ,CHCLEI,CH FI))
  1287               S ENDATE= $P($G(^CHM XCLF(CHFI, 1)),"^",12 )  ; ^CHMX CLF(I) END  DATE
  1288               F  S CHFI =$O(^CHMXC LF("B",CHC LEI,CHFI))  Q:'CHFI   D  ; CHECK  ALL LI "T O" DATES
  1289               .S TDATE= $P($G(^CHM XCLF(CHFI, 1)),"^",12 )
  1290               .I TDATE> ENDATE S E NDATE=TDAT E             ; TRACK  "YOUNGEST " END DATE
  1291               Q ENDATE
  1292               ;
  1293   LCA(TOC,CL NUM,CHCLF1 ,HACCLM,LN DATA)      ; FINAL LI NE ITEM CH ARGE AMOUN
  1294               N X2,CLLD 0
  1295               I HACCLM= "" Q ""
  1296               S (X,X2)= ""
  1297               F  S X2=$ O(LNDATA(C LNUM,HACCL M,X2)) Q:X 2=""  D
  1298               . S CLLD0 =LNDATA(CL NUM,HACCLM ,X2)
  1299               . S X=$G( X)+$S(TOC= "RXT":$P(C LLD0,"^",4 ),TOC="":$ P(CHCLF1," ^",6),1:$P (CLLD0,"^" ,2))
  1300               Q X
  1301               ;
  1302   LPA(TOC,CL NUM,CHCLFI ,HACCLM,CL TYPE,LNDAT A)      ;  FINAL LINE  ITEM PAYM ENT AMOUNT
  1303               ;
  1304               N X1,X2,X 3,X4,XLN,P IECE,CLLD0
  1305               N CHCLF70 ,CHCLF101, OHIPAY,OHI ADJ,DATA,S TOP,PRAMT, NOCLOHI
  1306               I HACCLM= "" Q 0
  1307               I $G(HACP AY(HACCLM) )="STOP" Q  0
  1308               S (XLN,X1 )=""
  1309               F  S X1=$ O(LNDATA(C LNUM,HACCL M,X1)) Q:X 1=""  D
  1310               . S X2=$O (^CHMPAY(H ACCLM,CLTY PE,X1,1,0) ) I 'X2 Q
  1311               . S X2=$G (^(X2,0))
  1312               . I +$P(X 2,"^",15)> 0 S XLN=$G (XLN)+$P(X 2,"^",15)  Q
  1313               . S XLN=$ G(XLN)+$P( X2,"^",12) -$P(X2,"^" ,16) Q
  1314               I XLN'=""  Q XLN
  1315               S TOC=$$T OS^CH835FU 1($P($G(^C HMPAY(HACC LM,0)),"^" ,7))
  1316               ;HAPE POR  12/12/13  already ha ve CLTYPE  set
  1317               ;;S CLTYP E=$S(TOC=" IPT":"INP- REV",TOC=" OPT":"OPT- PROC",TOC= "RXT":"PHA RM",TOC="D UR":"DME-S UPPLY",TOC ="DNT":"DE N-PROC",TO C="TRV":"O PT-PROC",1 :"OPT-PROC ")
  1318               S PIECE=$ S(TOC="DNT ":"5;7;2", TOC="DUR": "4;5;2",TO C="IPT":"2 ;2;2",TOC= "OPT":"3;5 ;2",TOC="R XT":"5;10; 4",TOC="TR V":"3;5;2" ,1:"")
  1319               I $G(CLMO TH(HACCLM) )'="" D
  1320               . S X1=0
  1321               . F  S X1 =$O(^CHMPA Y(HACCLM,C LTYPE,X1))  Q:X1'=+X1   S X2=^(X 1,0) D
  1322               .. S X3=$ G(X3)+$P(X 2,"^",$P(P IECE,";"))
  1323               . I TOC=" IPT" D  Q
  1324               .. S X4=X 3-$P($G(^C HMPAY(HACC LM,1)),"^" ,7)
  1325               .. I $FN( X4,"",2)=$ FN($P($G(^ CHMPAY(HAC CLM,1)),"^ "),"",2) K  CLMOTH(HA CCLM)
  1326               . I $FN(X 3,"",2)=$F N($P($G(^C HMPAY(HACC LM,1)),"^" ),"",2) K  CLMOTH(HAC CLM)
  1327               . Q
  1328               I $G(CLMO TH(HACCLM) )'="" D
  1329               . S X1=0, X3=0
  1330               . F  S X1 =$O(^CHMPA Y(HACCLM,C LTYPE,X1))  Q:X1'=+X1   S X2=^(X 1,0) D
  1331               .. S X3=$ G(X3)+$P(X 2,"^",$P(P IECE,";",3 ))
  1332               . S X4=X3 -$P($G(^CH MPAY(HACCL M,1)),"^", 7)
  1333               . I $FN(X 4,"",2)=$F N($P($G(^C HMPAY(HACC LM,1)),"^" ),"",2) S  $P(PIECE," ;")=$P(PIE CE,";",3)
  1334               . Q
  1335               I $D(^CHM XCLF(CHCLF I,70)) D   I $G(PRAMT )="" Q XLN
  1336               . S NOCLO HI=1
  1337               . S CHCLF 70=0 F  S  CHCLF70=$O (^CHMXCLF( CHCLFI,70, CHCLF70))  Q:CHCLF70' =+CHCLF70   D  I XLN' ="" Q
  1338               .. S OHIP AY=$G(OHIP AY)+$P($G( ^(CHCLF70, 0)),"^",2)
  1339               .. S CHCL F101=0 F   S CHCLF101 =$O(^CHMXC LF(CHCLFI, 70,CHCLF70 ,101,CHCLF 101)) Q:CH CLF101'=+C HCLF101  D   I XLN'=" " Q
  1340               ... S DAT A=$G(^(CHC LF101,0))
  1341               ... I $P( DATA,"^")= "PR" S XLN =$P(DATA," ^",3),STOP =1,PRAMT=X LN Q
  1342               ... F I=3 :3:18 S OH IADJ=$G(OH IADJ)+$P(D ATA,"^",I)
  1343               .. Q
  1344               . I $P($G (CHRJARR(1 ,1)),"*")= "F2" S XLN =0
  1345               . I $G(ST OP) Q
  1346               . S XLN=L ICHRGA-$G( OHIPAY)-$G (OHIADJ)
  1347               . I XLN<0  S XLN=0
  1348               . Q
  1349               S (X,X1)= ""
  1350               F  S X1=$ O(LNDATA(C LNUM,HACCL M,X1)) Q:X 1=""  D
  1351               . S CLLD0 =LNDATA(CL NUM,HACCLM ,X1)
  1352               . ;S PIEC E=$S(TOC=" DNT":"5;7; 2",TOC="DU R":"4;5;2" ,TOC="IPT" :"2;2;2",T OC="OPT":" 3;5;2",TOC ="RXT":"5; 10;4",TOC= "TRV":"3;5 ;2",1:"")
  1353               . ;I PIEC E="" Q
  1354               . I $G(NO CLOHI) K C LMOTH(HACC LM)
  1355               . S XLN=$ P(CLLD0,"^ ",$P(PIECE ,";"))
  1356               . ;I +$G( CLMOTH(HAC CLM))>0,XL N'>$P($G(^ CHMPAY(HAC CLM,1)),"^ ")
  1357               . ;I +$G( CLMOTH(HAC CLM))>0,XL N>$P($G(^C HMPAY(HACC LM,1)),"^" )
  1358               . ;;TEST  I +$G(CLMO TH(HACCLM) )>0,XLN>$P ($G(^CHMPA Y(HACCLM,1 )),"^") S  XLN=$P(CLL D0,"^",$P( PIECE,";", 3))
  1359               . I +$G(C LMOTH(HACC LM))>0,$P( CLLD0,"^", $P(PIECE," ;",3))>XLN  S XLN=$P( CLLD0,"^", $P(PIECE," ;",3))
  1360               . I $P(CL LD0,"^",$P (PIECE,";" ,2))'="" S  XLN=$P(CL LD0,"^",$P (PIECE,";" ,2))
  1361               . ;HAPE P OR - apply  cost shar e amount
  1362               . I $FN($ G(CLMCOST( HACCLM))," ",2)>0 D
  1363               .. I CLMC OST(HACCLM )>XLN S CL MCOST(HACC LM)=CLMCOS T(HACCLM)- XLN,XLN=0  Q
  1364               .. S XLN= XLN-CLMCOS T(HACCLM), CLMCOST(HA CCLM)=0
  1365               . ;HAPE P OR - apply  deductibl e amount
  1366               . I $FN($ G(CLMDED(H ACCLM)),"" ,2)>0,XLN> 0 D
  1367               .. I CLMD ED(HACCLM) >XLN S CLM DED(HACCLM )=CLMDED(H ACCLM)-XLN ,XLN=0 Q
  1368               .. S XLN= XLN-CLMDED (HACCLM),C LMDED(HACC LM)=0
  1369               . I $FN($ G(PATPAY(H ACCLM)),"" ,2)>0,XLN> 0 D
  1370               .. I PATP AY(HACCLM) >XLN S PAT PAY(HACCLM )=PATPAY(H ACCLM)-XLN ,XLN=0 Q
  1371               .. S XLN= XLN-PATPAY (HACCLM),P ATPAY(HACC LM)=0
  1372               . I $FN($ G(CLMOTH(H ACCLM)),"" ,2)>0,XLN> 0 D
  1373               .. I CLMO TH(HACCLM) >XLN S CLM OTH(HACCLM )=CLMOTH(H ACCLM)-XLN ,XLN=0 Q
  1374               .. S XLN= XLN-CLMOTH (HACCLM),C LMOTH(HACC LM)=0
  1375               . S X=$G( X)+XLN
  1376               . I TOC=" IPT" S X=$ G(IPTAMT(H ACCLM,CHCL FI))
  1377               I $P(CHRJ ARR(1,1)," *")="F2" S  X="0.00"
  1378               I $G(PRAM T)'="",PRA MT<X D  Q  PRAMT
  1379               . I $G(HA CPAY(HACCL M))'="",HA CPAY(HACCL M)'="STOP"  S HACPAY( HACCLM)=HA CPAY(HACCL M)-PRAMT I  HACPAY(HA CCLM)'>0 S  HACPAY(HA CCLM)="STO P"
  1380               I $G(HACP AY(HACCLM) )="STOP" S  X=0
  1381               Q X
  1382               ;
  1383   LQTY(TOC,C LNUM,CHCLF 1,HACCLM,L NDATA)     ; FINAL QU ANTITY - U NITS OF SE RVCE
  1384               N X2,PIEC E,XLN,CLLD 0,STOP
  1385               I HACCLM= "" Q 0
  1386               S (X,X2)= ""
  1387               F  S X2=$ O(LNDATA(C LNUM,HACCL M,X2)) Q:X 2=""  Q:$G (STOP)  D
  1388               . S CLLD0 =LNDATA(CL NUM,HACCLM ,X2)
  1389               . S PIECE =$S(TOC="D NT":13,TOC ="DUR":11, TOC="IPT": 4,TOC="OPT ":19,TOC=" TRV":19,TO C="RXT":15 ,1:"")
  1390               . S XLN=$ P(CLLD0,"^ ",PIECE)
  1391               . I XLN=" " S X=$P(C HCLF1,"^", 8),STOP=1  Q
  1392               . S X=X+X LN
  1393               Q X
  1394               ;
  1395               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  1396               ; DOCUMEN TREC (UTIL ITY THAT H ELPS IN DO CUMENTING  THE RECORD  GENERATIO N PROCESS)  ;
  1397               ; CREATES  A FILE TH AT CONTAIN S THE RECO RD INFORMA TION FOR T HE 5010 ;
  1398               ; EMDEON  STATUS REC ORDS, INCL UDING THE  HEADER, CL AIM, LINE  ITEM, AND  TRAILER ;
  1399               ; RECORDS . THIS FUN CTION USES  THE FIELD  DESCRIPTO RS TO DOCU MENT EACH  FIELD IN ;
  1400               ; THE REC ORDS, I.E. : ;
  1401               ; 1) RECO RD NAME ;
  1402               ; 2) STAR TING LOCAT ION IN THE  RECORD ;
  1403               ; 3) LENG TH (WIDTH)  OF THE FI ELD ;
  1404               ; 4) JUST IFICATION  WITHIN THE  FIELD ;
  1405               ; 5) THE  VALUE (HAR D CODED FI ELDS) OR T HE CACHE F ILELOCATIO N FROM WHI CH THE ;
  1406               ; VALUE I S RETRIEVE D. ;
  1407               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  1408               ;
  1409   DOCUMENTRE C     ;
  1410               N DOCFILE ,TMPIO,LN, HTABS,FTAB S,RTYPE,RN AME,CHTYPE ,STR,COLNM S
  1411               S RTYPE=" EMDEONHDR^ EMDEONCLM^ EMDEONSTC^ EMDEONTRLR ^EMDEONLI"  ; NAMES O F $TEXT TA BLES
  1412               S COLNMS= "FIELD NAM E^USE^DESC ^PAD^JUST^ VALUE"  ;  COLUMN HEA DER NAMES
  1413               S HTABS=" 35^39^45^5 0^57"                         ;  HEADER TAB  STOPS FOR  THE FIELD  DESCRIPTI ONS
  1414               S FTABS=" 36^39^46^5 2^57"                         ;  FIELD TAB  STOPS FOR  DESCRIPTIO NS
  1415               S DOCPATH ="HAC_HFS$ :[KERMIT.W EBMD]"
  1416               S DOCFILE ="DOC277_5 010_"_DATE STAMP_".TX T"      ;  STATUS MAP PING DOCUM ENTATION
  1417               S DOCFILE =DOCPATH_D OCFILE                        ;  OUTPUT THE  $TEXT TO  A PRINTABL E FILE
  1418               S FLAG=$$ OFILE^CHMX WBUT(DOCFI LE,"NWS")
  1419               S TMPIO=$ IO U DOCFI LE
  1420               F CHTYPE= 1:1 S RNAM E=$P(RTYPE ,"^",CHTYP E) Q:RNAME =""  D
  1421               .W !!,?20 ,"HEALTH C ARE CLEARI NG HOUSE " "",RNAME," "" RECORD  DEFINITION S"  ; TITL E
  1422               .W !,$P(C OLNMS,"^", 1),?$P(HTA BS,"^",1), $P(COLNMS, "^",2),?$P (HTABS,"^" ,2),$P(COL NMS,"^",3) ,?$P(HTABS ,"^",3),$P (COLNMS,"^ ",4),?$P(H TABS,"^",4 ),$P(COLNM S,"^",5),? $P(HTABS," ^",5),$P(C OLNMS,"^", 6),?$P(HTA BS,"^",6), $P(COLNMS, "^",7)
  1423               .F LN=1:1  S STR=$T( @RNAME+LN)  Q:STR["EN D OF RECOR D"  D   ;  READ $TEXT  DESCRIPTO R
  1424               ..W !,$P( STR,";",3) ,?$P(FTABS ,"^",1),$P (STR,";",1 0),?$P(FTA BS,"^",2), $P(STR,";" ,8),?$P(FT ABS,"^",3) ,$P(STR,"; ",7),?$P(F TABS,"^",4 ),$P(STR," ;",6),?$P( FTABS,"^", 5),$P(STR, ";",4)
  1425               U TMPIO
  1426               D CLOSEFI LE^CHMXWBU T(DOCFILE)  ; CLOSE C URRENT FIL E
  1427               Q
  1428               ;
  1429   CHECK(HACC LM,CHCLFI)     ;final  check for  date of s ervice, if  matched,  but hac cl aim status  = 0
  1430               N SRVDT,S RVDT2
  1431               S SRVDT=$ P(^CHMPAY( HACCLM,0), "^",8),SRV DT2=$P(^CH MXCLF(CHCL FI,1),"^", 11)
  1432               I SRVDT2' ="" S SRVD T2=$S($E(S RVDT2,1,2) =19:2_$E(S RVDT2,3,8) ,1:3_$E(SR VDT2,3,8))
  1433               I SRVDT2= ""!(SRVDT= "") Q 1
  1434               I SRVDT'= SRVDT2 Q 0
  1435               Q 1
  1436               ;
  1437   AGAIN   ;  check to s ee if line s need to  be recheck ed with di ffernt uni ts
  1438               S AGAIN=1 ,LN=$O(^CH MPAY(HACCL M,CLTYPE,0 ))
  1439               Q
  1440               ;
  1441   RESET   ;H APE POR -  to reset a  file crea tion to en able claim s to be re -submitted  as Final
  1442               N XA,XB,X T,XX,XT1,E NDDATE,CT, X,RUNDATE
  1443               K ^XTMP($ J)
  1444               S %H=$H-7 30 D YMD^% DTC S ENDD ATE=X
  1445               S XA="" F   S XA=$O( ^CHMPAY("E ",XA),-1)  Q:XA=""  Q :$P(XA,"." )<ENDDATE   D
  1446               . S XB=""  F  S XB=$ O(^CHMPAY( "E",XA,XB) ) Q:XB=""   D
  1447               .. ;02/10 /2014 SBB  DEV020322
  1448               .. ;I ^(X B)'="" S ^ XTMP($J,^C HMPAY("E", XA,XB))=$G (^XTMP($J, ^CHMPAY("E ",XA,XB))) +1,^XTMP($ J,^CHMPAY( "E",XA,XB) ,XB)=XA
  1449               .. S RUND ATE=$P(^CH MPAY(XB,10 ),"^",23)  I RUNDATE' ="" S ^XTM P($J,RUNDA TE)=$G(^XT MP($J,RUND ATE))+1,^X TMP($J,RUN DATE,XB)=X A
  1450               .. Q
  1451               . Q
  1452   R0       ; S XA="" F   S XA=$O(^ XTMP($J,XA )) Q:XA=""   S CT=$G( CT)+1,XT1( CT)=XA,%TN =$P($P(XA, "#",2),"," ,2) D ^%TO  W !,CT,?5 ,$P(XA,"#" ),?20,%TS, ?30,^XTMP( $J,XA)," C LAIMS"
  1453           S  XA="" F  S  XA=$O(^XT MP($J,XA))  Q:XA=""   S CT=$G(CT )+1,XT1(CT )=XA N RDT  S X=XA D  H^%DTC S % TN=%T,RDT= %H D ^%TO  W !,CT,?5, $ZD(RDT),? 20,%TS,?30 ,^XTMP($J, XA)," CLAI MS"
  1454   R1       R  !!,"SELEC T FILE CRE ATION TO R ESET: ",XX
  1455               I XX="" Q
  1456               I '$D(XT1 (XX)) W *7 ,!,"Invali d Entry.   Please ret ry." G R1
  1457               W !!,"Res etting..."
  1458               S XB="" F   S XB=$O( ^XTMP($J,X T1(XX),XB) ) Q:XB=""   D
  1459               . S XA=^X TMP($J,XT1 (XX),XB)
  1460               . I XA=""  Q
  1461               . ;02/10/ 2014 SBB D EV020322
  1462               . ;I $D(^ CHMPAY("E" ,XA,XB)) S  ^CHMPAY(" E",XA,XB)= ""
  1463               . I $D(^C HMPAY("E", XA,XB)) S  DR="10.23/ //@",DIE=" ^CHMPAY(", DA=XB D ^D IE
  1464               . Q
  1465               K ^XTMP($ J,XT1(XX))
  1466               K XT1 S C T=0
  1467               G R0
  1468               Q
  1469               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  1470               ; EMDEONH DR: Common  Header fo r EMDEON S TATUS File s ;
  1471               ; A singl e header i s generate d for each  output fi le. ;
  1472               ; DESC: " FIELD NAME ";"LENGTH" ;"JUSTIFY  FLAG";"PAD  CHAR";"DA TA TYPE";  ;
  1473               ; FIELD N AME: EMDEO N File FIE LD DESCRIP TOR(record  # and tex t descript ion) ;
  1474               ; LENGTH:  EMDEON FI LE SPECIFI ED FIELD W IDTH ;
  1475               ; JUSTIFY  FLAG: L=L EFT, R=RIG HT, C= CEN TER ;
  1476               ; PAD: PA D CHARACTE R TO BE US ED TO FILL  FIELD WID TH (ANY PR INTABLE CH ARACTER) ;
  1477               ; NOTE: P AD CHAR=""  IF NO CHA RACTER IS  BETWEEN TH E SEMICOLO NS (I.E. ; ;) ;
  1478               ; NO PADD ING WILL O CCUR IF TH IS IS SET  UP THIS WA Y ;
  1479               ; DATA PA TTERN: PAT TERN MATCH  DESCRIPTO R DESCRIBI NG THE VAL UE ;
  1480               ; FIELD S TART LOCAT ION: LOCAT ION IN REC ORD FOR TH IS FIELD-D OCUMENTATI ON ONLY ;
  1481               ; FIELD U SE: R=REQU IRED, C=CO NDITIONAL,  O=OPTIONA L ;
  1482               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  1483               ; ;
  1484               ; FORMATD ATA TREATS  THE PAD C HAR (;;) A S A NULL,  SO NO PADD ING OCCURS . ;
  1485               ; THIS WI LL ALLOW U SE OF THE  FORMATDATA  FUNCTION  WITHOUT MO DIFICATION  BETWEEN ;
  1486               ; PADDED  AND NON-PA DDED FIELD S. ;
  1487               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  1488               ; 8/4/11  DLB "6. CR EATION TIM E" FROM $E (DATESTAMP ,9,12) TO  $E(DATESTA MP,9,14) ;
  1489               ; 8/15/11  DLB "2. F ILE GROUP  ID" INSERT ED THE DAT ESTAMP VAL UE TO ENSU RE UNIQUEN ESS ;
  1490               ; 11/13/1 3 HAPE POR  - problem  with usin g DATESTAM P for GROU P ID
  1491               ;           Multi-fi le submiss ion needs  GROUPID to  be the sa me in each  file
  1492               ; 9/7/201 1 DLB 12.  LOAD TYPE  CHANGED TO  PROVIDE " F" WHEN HI STORICAL F ILE GENERA TED ;
  1493               ;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;
  1494               ;  
  1495   EMDEONHDR        ;"FI ELD NAME"; "TARGET VA LUE";"LENG TH";"JUSTI FY FLAG";" PAD CHAR"; DATA LENGT H/PATTERN" ;FIELD STA RT LOCATIO N;FIELD US E
  1496                     ;;1 .RECORD ID ;"HDR";3;L ;;3AN;0;R;
  1497                     ;;2 .FILE GROU P ID;GROUP ID;20;L;;2 0AN;4;R;
  1498                     ;;3 .FILE GROU P SEQUENCE  NUMBER;FI LECNT;3;R; ;3N;24;R;
  1499                     ;;4 .FILE GROU P COUNT;GR PCNT;3;R;; 3N;26;R;
  1500                     ;;5 .CREATION  DATE;$E(DA TESTAMP,1, 8);8;L;;8A N;28;R;
  1501                     ;;6 .CREATION  TIME;$E(DA TESTAMP,9, 14);6;L;;6 N;36;R;
  1502                     ;;7 .TRADING P ARTNER ID; "VAFNH";10 ;L;;10AN;4 2;R;
  1503                     ;;8 .SUBMITTER  NAME;"VA,  HEALTH AD MIN CENTER ";30;L;;30 AN;53;R;
  1504                     ;;9 .PAYER CON TACT NAME; PAYNAME;60 ;L;;60AN;8 3;O;
  1505                     ;;1 0.PAYER SU PPORT TELE PHONE NUMB ER;PAYPHON E;10;L;;10 N;143;O;
  1506                     ;;1 1.PAYER SU PPORT EMAI L ADDRESS; "";80;L;;8 0AN;153;O;
  1507                     ;;1 2.LOAD TYP E;LOADTYPE ;1;L;;1AN; 233;R;
  1508                     ;;1 3.PAYER UN IQUE FILE  IDENTIFIER ;DATESTAMP ;20;L;;20A N;234;R;
  1509                     ;;1 4.FILE TYP E;"CStat"; 5;L;;5AN;2 54;R;
  1510                     ;;1 5.VERSION  CODE;"03"; 2;L;;2AN;2 58;R;
  1511                     ;;1 6.RELEASE  CODE;"00"; 2;L;;2AN;2 60;R;
  1512                     ;;1 7.END OF R ECORD;
  1513                     ;      
  1514                     ;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; 
  1515                     ; E MDEON CLAI M lEVEL ST ATUS TABLE : Contains  the Descr iptions fo r all data  to be ; 
  1516                     ; g athered fo r E01 File . Used by  $TEXT to g ather all  data & set  up format  ;
  1517                     ; E ach record  is descri bed in det ail for th e followin g Paramete rs: ;
  1518                     ; T his table  is used as  a block o f data(a r ecord) for  each clai m to be pr ocessed. ;
  1519                     ; T herefore,  separating  this from  the heade r and trai ler tables  allows mu ltiple ;
  1520                     ; c alls to th is table. 
  1521                     ;-- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- -;
  1522                     ; F IELD NAME; LENGTH;JUS TIFY FLAG; PAD CHAR;D ATA TYPE;  ;
  1523                     ; F IELD NAME:  EMDEON Fi le FIELD D ESCRIPTOR  ;
  1524                     ; L ENGTH: EMD EON FILE S PECIFIED F IELD WIDTH  ;
  1525                     ; J USTIFY FLA G: L=LEFT,  R=RIGHT ;
  1526                     ; P AD: PAD CH ARACTER TO  BE USED T O FILL FIE LD WIDTH ;
  1527                     ; P ATTERN: PA TTERN MATC H DESCRIPT OR DESCRIB ING THE VA LUE ;
  1528                     ; F IELD START  LOCATION:  LOCATION  IN RECORD  FOR THIS F IELD-DOCUM ENTATION O NLY ;
  1529                     ; F IELD USE:  R=REQUIRED , C=CONDIT IONAL, O=O PTIONAL ;
  1530                     ;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  1531                     ; 8 /4/11 DLB  "3. PAYER  ID" FROM " VAHAC" TO  $$GETPAYID ^CHMXWB21( CHMXTPI) ;
  1532                     ; 8 /5/11 DLB  FIELDS 12, 14,15: TYP O FIXED FO R PROVIDER  INFO (ADD ED ^ TO CH MXCLB) ;
  1533                     ; 8 /5/11 DLB  FIELD 41:  CHANGED IN DEX FROM ^ CHMXCLE(I, 100 TO ^CH MXCLE(I,0 
  1534                     ;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  1535                     ; 
  1536   EMDEONCLM        ;"FI ELD NAME"; "TARGET VA LUE";"LENG TH";"JUSTI FY FLAG";" PAD CHAR"; "DATA LENG TH/PATTERN ";FIELD ST ART LOCATI ON";FIELD  USE
  1537                     ;;1 .RECORD ID ;"CLM";3;L ;;3AN;0;R;
  1538                     ;;2 .RECORD NU MBER;COUNT ;10;R;;10A N;4;R;
  1539                     ;;3 .PAYER ID; "VAHAC";5; L;;5AN;14; R;
  1540                     ;;4 .MAINTENAN CE TYPE CO DE;$S($G(F ULL)=1:"03 0",$G(RUNT YPE)="F":" 021",$G(RU NTYPE)="A" :"021",$G( RUNTYPE)=" P":"021",$ G(RUNTYPE) ="H":"030" ,1:"001"); 3;L;;3AN;1 9;R;
  1541                     ;;5 .BILLING P ROVIDER FE DERAL TAX  ID;BPFTI;9 ;L;;9N;22; C;
  1542                     ;;6 .BILLING P ROVIDER PA YER NUMBER ;BPPN;50;L ;;50AN;31; C;
  1543                     ;;7 .BILLING P ROVIDER NA TIONAL ID; BPNID;10;L ;;10N;81;C ;
  1544                     ;;8 .BILLING P ROVIDER LA ST NAME;BP LNAME;60;L ;;60AN;91; C;
  1545                     ;;9 .BILLING P ROVIDER FI RST NAME;B PFNAME;35; L;;35AN;15 1;O;
  1546                     ;;1 0.BILLING  PROVIDER M IDDLE NAME ;BPMNAME;2 5;L;;25AN; 186;O;
  1547                     ;;1 1.BILLING  PROVIDER N AME SUFFIX ;BPNAMEX;1 0;L;;10AN; 211;O;
  1548                     ;;1 2.SERVICE  PROVIDER F EDERAL TAX  ID;SPFTID ;9;L;;9N;2 21;C;
  1549                     ;;1 3.SERVICE  PROVIDER P AYER NUMBE R;SPPN;50; L;;50AN;23 0;C;
  1550                     ;;1 4.SERVICE  PROVIDER N ATIONAL ID ;SPNID;10; L;;10N;280 ;C;
  1551                     ;;1 5.SERVICE  PROVIDER L AST NAME;S PLNAME;60; L;;60AN;29 0;C;
  1552                     ;;1 6.SERVICE  PROVIDER F IRST NAME; SPFNAME;35 ;L;;35AN;3 50;O;
  1553                     ;;1 7.SERVICE  PROVIDER M IDDLE NAME ;SPMNAME;2 5;L;;25AN; 385;O;
  1554                     ;;1 8.SERVICE  PROVIDER N AME SUFFIX ;SPNAMEX;1 0;L;;10AN; 410;O;
  1555                     ;;1 9.EMPLOYER  IDENTIFIC ATION NUMB ER;EMPIDNU M;80;L;;80 AN;420;C;
  1556                     ;;2 0.EMPLOYER  NAME;EMPN AME;60;L;; 60AN;500;C ;
  1557                     ;;2 1.SUBSCRIB ER ID;SUBS CID;80;L;; 80AN;580;C ;
  1558                     ;;2 2.SUBSCRIB ER LAST NA ME;SUBLNAM E;60;L;;60 AN;660;C;
  1559                     ;;2 3.SUBSCRIB ER FIRST N AME;SUBFNA ME;35;L;;3 5AN;720;O;
  1560                     ;;2 4.SUBSCRIB ER MIDDLE  NAME;SUBMN AME;25;L;; 25AN;755;O ;
  1561                     ;;2 5.SUBSCRIB ER NAME SU FFIX;SUBNA MEX;10;L;; 10AN;780;O ;
  1562                     ;;2 6.PATIENT  ID;PATID;8 0;L;;80AN; 790;O; 
  1563                     ;;2 7.PATIENT  LAST NAME; PATLNAME;6 0;L;;60AN; 870;R;
  1564                     ;;2 8.PATIENT  FIRST NAME ;PATFNAME; 35;L;;35AN ;930;R;
  1565                     ;;2 9.PATIENT  MIDDLE NAM E;PATMNAME ;25;L;;25A N;965;O;
  1566                     ;;3 0.PATIENT  NAME SUFFI X;PATNAMEX ;10;L;;10A N;990;O;
  1567                     ;;3 1.PATIENT  DATE OF BI RTH;PATDOB ;8;L;;8DT; 1000;R;
  1568                     ;;3 2.PATIENT  GENDER;PAT GENDR;1;L; ;1AN;1008; O;
  1569                     ;;3 3.EMDEON C LAIM NUMBE R;ECLMNUM; 50;L;;50AN ;1009;O;
  1570                     ;;3 4.CLAIM CH ARGE AMOUN T;CLMCHRG; 18;L;;18N; 1059;R;
  1571                     ;;3 5.CLAIM PY MT AMT;CLM PMT;18;R;; 18N;1077;C ;
  1572                     ;;3 6.CLAIM AD J/PAYMENT  DATE;CAPD; 8;L;;8DT;1 095;C;
  1573                     ;;3 7.CHECK/EF T DATE;CHK EFTDATE;8; L;;8DT;110 3;O;
  1574                     ;;3 8.CHECK/EF T NUMBER;C HKEFTNUM;1 6;L;;16AN; 1111;O;
  1575                     ;;3 9.BILL TYP E;BTYPE;3; L;;3AN;112 7;O;
  1576                     ;;4 0.PAYER CL AIM ID NUM BER;PCIDNU M;50;L;;50 AN;1130;R;
  1577                     ;;4 1.PATIENT  ACCOUNT NU MBER;PATAC CT;50;L;;5 0AN;1180;O
  1578                     ;;4 2.PHARMACY  PRESCRIPT ION NUMBER ;PRSCNUM;5 0;L;;50AN; 1230;O;
  1579                     ;;4 3.VOUCHER  IDENTIFIER ;VOUCHID;5 0;L;;50AN; 1280;O;
  1580                     ;;4 4.APP/LOCA TION SYSTE M ID;LOCSY SID;50;L;; 50AN;1330; O;
  1581                     ;;4 5.GROUP NU MBER;GRPNU M;50;L;;50 AN;1380;O;
  1582                     ;;4 6.CLAIM SE RVICE DATE  START;CLM STDT;8;L;; 8DT;1430;R ;
  1583                     ;;4 7.CLAIM SE RVICE DATE  END;CLMEN DT;8;L;;8D T;1438;R;
  1584                     ;;4 8.END OF R ECORD;
  1585                     ;
  1586                     ;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;;
  1587                     ; E MDEON CLAI M STATUS R ECORD DETA IL: Contai ns the Des criptions  for all da ta to be ;  
  1588                     ; g athered fo r Claim le vel and Li ne Level r ecords. Us ed by $TEX T to gathe r all ;
  1589                     ; d ata & set  up format.  ;
  1590                     ; E ach record  is descri bed in det ail for th e followin g Paramete rs: ;
  1591                     ; N OTE: ;
  1592                     ; F or each CL M record,  there must  be at lea st one STC  record. ;
  1593                     ; F or a singl e CLM reco rd, The fo llowing is  true abou t DTL reco rds: ;
  1594                     ; 1 ) Payer ca n send any  number of  DTL recor ds (includ ing NONE)  ;
  1595                     ; 3 ) Each DTL  record se nt corresp onds to Li ne Level i nfo for th e CLM reco rd. ;
  1596                     ; 4 ) For each  DTL recor d sent, th ere must b e at least  one STC r ecord. ;
  1597                     ;-- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- -;
  1598                     ; F IELD NAME; LENGTH;JUS TIFY FLAG; PAD CHAR;D ATA TYPE;  ;
  1599                     ; F IELD NAME:  EMDEON FI LE FIELD D ESCRIPTOR  ;
  1600                     ; L ENGTH: EMD EON FILE S PECIFIED F IELD WIDTH  ;
  1601                     ; J USTIFY FLA G: L=LEFT,  R=RIGHT ;
  1602                     ; P AD: PAD CH ARACTER TO  BE USED T O FILL FIE LD WIDTH ;
  1603                     ; D ATA PATTER N: PATTERN  MATCH DES CRIPTOR DE SCRIBING T HE VALUE ;
  1604                     ; F IELD START  LOCATION:  LOCATION  IN RECORD  FOR THIS F IELD-DOCUM ENTATION O NLY ;
  1605                     ; F IELD USE:  R=REQUIRED , C=CONDIT IONAL, O=O PTIONAL ;
  1606                     ;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  1607                     ; 8 /4/11 DLB  "3. PAYER  ID" FROM " VAHAC" TO  $$GETPAYID ^CHMXWB21( CHMXTPI) ;  
  1608                     ;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;; 
  1609                     ; 
  1610   EMDEONSTC        ;"FI ELD NAME"; "TARGET VA LUE";"LENG TH";"JUSTI FY FLAG";" PAD CHAR"; "DATA PATT ERN";FIELD  START LOC ATION;FIEL D USE
  1611                     ;;1 .RECORD ID ;"STC";3;L ;;3AN;0;R;
  1612                     ;;2 .RECORD NU MBER;COUNT ;10;R;;10A N;3;R;
  1613                     ;;3 .PAYER ID; "VAHAC";5; L;;5AN;13; R;
  1614                     ;;4 .PAYER CLA IM ID NUMB ER;PCINUM; 50;L;;50AN ;18;R;
  1615                     ;;5 .LINE ITEM  CONTROL N UMBER;LICN UM;50;L;;5 0AN;68;O;
  1616                     ;;6 .STATUS IN FORMATION  EFF. DATE; DATESTAMP; 14;L;;14N; 118;R;
  1617                     ;;7 .CLAIM STA TUS CATEGO RY CODE;RJ CODE;3;L;; 3AN;126;R;
  1618                     ;;8 .CLAIM STA TUS CODE;R JSTATUS;3; L;;3AN;129 ;R;
  1619                     ;;9 .ENTITY CO DE;ENTITY; 3;L;;3AN;1 32;O;
  1620                     ;;1 0.DATA IN  ERROR;DATE RR;264;L;; 264AN;135; O;
  1621                     ;;1 1.EMDEON S TATUS CODE ;ESCODE;5; L;;5AN;399 ;O;
  1622                     ;;1 2.END OF R ECORD;
  1623                     ;    
  1624                     ;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  1625                     ; E MDEONTRLR:  Common Tr ailer for  EMDEON Sta tus Files  ;
  1626                     ; N OTE: a sin gle traile r record i s generate d for each  output fi le. ;
  1627                     ; F IELD NAME; LENGTH;JUS TIFY FLAG; PAD CHAR;D ATA TYPE;  ;
  1628                     ; F IELD NAME:  277 File  FIELD DESC RIPTOR ;
  1629                     ; L ENGTH: 277  FILE SPEC IFIED FIEL D WIDTH ;
  1630                     ; J USTIFY FLA G: L=LEFT,  R=RIGHT ;
  1631                     ; P AD: PAD CH ARACTER TO  BE USED T O FILL FIE LD WIDTH ;
  1632                     ; D ATA PATTER N: PATTERN  MATCH DES CRIPTOR DE SCRIBING T HE VALUE ;
  1633                     ; F IELD START  LOCATION:  LOCATION  IN RECORD  FOR THIS F IELD-DOCUM ENTATION O NLY ;
  1634                     ; F IELD USE:  R=REQUIRED , C=CONDIT IONAL, O=O PTIONAL ;
  1635                     ;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;
  1636                     ;      
  1637   EMDEONTRLR       ;"FI ELD NAME"; "TARGET VA LUE";"LENG TH";"JUSTI FY FLAG";" PAD CHAR"; "DATA PATT ERN";FIELD  START LOC ATION;FIEL D USE
  1638                      ;; 1.RECORD I D;"TRLR";4 ;L;;4AN;0; R;
  1639                      ;; 2.RECORD C OUNT;COUNT ;10;R;;10N ;4;R;
  1640                      ;; 3.END OF R ECORD; 
  1641                      ;                     
  1642                      ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;; 
  1643                      ;  EMDEON LIN E LEVEL ST ATUS TABLE : Contains  the Descr iptions fo r all data  to be ; 
  1644                      ;  gathered f or CRF Fil e. Used by  $TEXT to  gather all  data & se t up forma t ;
  1645                      ;  Each recor d is descr ibed in de tail for t he followi ng Paramet ers: ;
  1646                      ;  NOTE: ther e may be m ultiple li ne items f or each cl aim record . This tab le ;
  1647                      ;  defines th e record t o be gener ated for e ach line i tem. ; 
  1648                      ;- ---------- ---------- ---------- ---------- ---------- ---------- ---------- ---------- --;
  1649                      ;  FIELD NAME ;LENGTH;JU STIFY FLAG ;PAD CHAR; DATA TYPE;  ;
  1650                      ;  FIELD NAME : EMDEON F ILE FIELD  DESCRIPTOR  ;
  1651                      ;  LENGTH: EM DEON FILE  SPECIFIED  FIELD WIDT H ;
  1652                      ;  JUSTIFY FL AG: L=LEFT , R=RIGHT  ;
  1653                      ;  PAD: PAD C HARACTER T O BE USED  TO FILL FI ELD WIDTH  ;
  1654                      ;  DATA PATTE RN: PATTER N MATCH DE SCRIPTOR D ESCRIBING  THE VALUE  ;
  1655                      ;  FIELD STAR T LOCATION : LOCATION  IN RECORD  FOR THIS  FIELD-DOCU MENTATION  ONLY ;
  1656                      ;  FIELD USE:  R=REQUIRE D, C=CONDI TIONAL, O= OPTIONAL ;
  1657                      ;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;;;;;;;; ;;;
  1658                      ;   
  1659   EMDEONLI         ;"FI ELD NAME"; "TARGET VA LUE";"LENG TH";"JUSTI FY FLAG";" PAD CHAR"; "DATA PATT ERN";FIELD  START LOC ATION;FIEL D USE
  1660                    ;;1. RECORD ID; "DTL";3;L; ;3AN;0;R;
  1661                    ;;2. RECORD NUM BER;COUNT; 10;R;;10AN ;4;R;
  1662                    ;;3. PAYER ID;" VAHAC";5;L ;;5AN;14;R ;
  1663                    ;;4. PAYER CLAI M ID NUMBE R;PCID;50; L;;50AN;19 ;R;
  1664                    ;;5. LINE ITEM  CONTROL NU MBER;LICN; 50;L;;50AN ;69;R;
  1665                    ;;6. SERVICE QU ALIFIER ID ;SQID;2;L; ;2AN;119;R ;
  1666                    ;;7. SERVICE ID ENTIFICATI ON CODE;SI CODE;48;L; ;48AN;121; R;
  1667                    ;;8. PROCEDURE  MODIFIER 1 ;PRCM1;2;L ;;2AN;131; O;
  1668                    ;;9. PROCEDURE  MODIFIER 2 ;PRCM2;2;L ;;2AN;133; O;
  1669                    ;;10 .PROCEDURE  MODIFIER  3;PRCM3;2; L;;2AN;135 ;O;
  1670                    ;;11 .PROCEDURE  MODIFIER  4;PRCM4;2; L;;2AN;137 ;O;
  1671                    ;;12 .LI CHARGE  AMOUNT;LI CHRGA;18;L ;;18N;139; R;
  1672                    ;;13 .LINE ITEM  PROV. PAY MENT AMOUN T;LIPPA;18 ;L;;18N;15 7;R;
  1673                    ;;14 .REVENUE C ODE;RVNUCO DE;48;L;;4 8AN;175;C;
  1674                    ;;15 .QUANTITY( UNITS OF S ERVICE);QT YUOS;15;L; ;15N;223;O ;
  1675                    ;;16 .EMDEON CL AIM NUMBER ;ECLMNUM;5 0;L;;50AN; 238;O;
  1676                    ;;17 .SRVC STAR T DATE;SVC STDATE;8;L ;;8N;288;R ;
  1677                    ;;18 .SRVC END  DATE;SVCEN DATE;8;L;; 8N;306;R;
  1678                    ;;19 .END OF RE CORD;