44. EPMO Open Source Coordination Office Redaction File Detail Report

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

44.1 Files compared

# Location File Last Modified
1 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHEDIF1.m Mon Nov 5 16:42:14 2018 UTC
2 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHEDIF1.m Fri Nov 9 01:06:01 2018 UTC

44.2 Comparison summary

Description Between
Files 1 and 2
Text Blocks Lines
Unchanged 5 860
Changed 4 12
Inserted 0 0
Removed 0 0

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

44.4 Active regular expressions

No regular expressions were active.

44.5 Comparison detail

  1   CHEDIF1 ;H AC/AEB;EDI  835 FILE
  2    ;;1.0;;CH AMPVA SYST EM;JULY 4,  1990;Buil d 4
  3    ;;BST-020 6-20093      X12 835  EXTRACT-FI LE CREATIO N-FMS LOOP ; 06-15-20 01;;;Build  10
  4    ;;DEF0165 54, SBB, 1 1/26/13 -  Modified W riting to  a file as  per VHA st andard.
  5    ;;DEF0165 54, SBB, 1 2/02/13 -  Converting  from DECN ET to FTP.
  6    ;;DEF0165 54, SBB, 0 7/30/15 -  Adding cha nges for D ECNET
  7    ;
  8    ;;COPIED  FROM CHEDI F1 (jbm) P I 3 Duplic ation and  Change Req uest  MC16 1 "X12 835  PI 3 Dupl ication"   02/08/2006  RKN
  9    ;;1.0 IS  THE INITIA L VERSION  (HIPAA Rea dy LLC) Ad ded code f or MDMTRX
  10    ;;
  11   NEW ; Crea te a new f ile run
  12    K ^CHMEDI F("C",0)
  13    N POP
  14    S POP=0
  15    D GETCLMS  Q:'POP  
  16    D FCREATE
  17    D WBADVID
  18    K ^CHMZHO LD("RKN_83 5OUT")
  19    Q
  20    ;
  21   RERUN ;
  22    ;S POP=0
  23    ;D GETFIL E Q:POP
  24    ;S FILEI= 756
  25    W !,"Ente r FILEI "  R FILEI
  26    ;
  27    D FCREATE
  28    Q
  29   GETFILE ;
  30    Q
  31   GETCLMS ;G ets claims  from CHME DI file wi th a statu s of "NEED S 835 SENT " and
  32    ;sets a n ew file nu mber to it . This fil e is then  used to cr eate 
  33    ;EDI 835  files.
  34    ;Check to  see if cu rrent 835  file gener ation is i nprogress
  35    I $D(^CHM EDIF("C",0 )) S POP=1  Q
  36    I '$D(^CH MEDI("D",0 )) S POP=1  Q  ; Quit  if no cla ims need s ent
  37    ;Get new  file numbe r
  38    L ^CHMEDI F(0)
  39    S FILEI=$ P(^CHMEDIF (0),"^",3)  S:'FILEI  FILEI=0
  40    S FILEI=F ILEI+1 
  41    S $P(^CHM EDIF(0),"^ ",3)=FILEI ,$P(^CHMED IF(0),"^", 4)=FILEI L
  42    D NOW^%DT C
  43    S ^CHMEDI F("B",%,FI LEI)=""
  44    S $P(^CHM EDIF(FILEI ,0),"^",1) =%
  45    ;set stat us to inpr ogrss and  set x-ref
  46    S $P(^CHM EDIF(FILEI ,0),"^",2) =0
  47    S ^CHMEDI F("C",0,FI LEI)=""
  48    ;
  49    ;Set clai ms to new  file numbe r
  50   TEST K ^CH MZHOLD("RK N_835OUT")
  51    S I=0 F   S I=$O(^CH MEDI("D",0 ,I)) Q:'I   D
  52    .;RKN 05/ 17/2004 ch eck for ve ndor id pt  (VENI)
  53    .;in $P(^ CHMEDI(I,0 ),"^",5) &  $P(CHMPAY (CLMI,0)," ^",3)
  54    .;and upd ate both f rom $P(CHM IMAGE(PDI, "P-VEN",J, 0),"^",1)
  55    .K XRKNCL MPT,XRKNPD I,XRKNJVAL ,XRKNJVAL, XRKNVID
  56    .D NOW^%D TC S CHCDT =%
  57    .S XRKNCL MPT=$P(^CH MEDI(I,1,1 ,0),"^",1)
  58    .S X1=XRK NCLMPT D P ROGTYP^CHF CD001
  59    .S CHEFTC K=""
  60    .S:$D(@(G LPAY_"XRKN CLMPT,7)") ) CHEFTCK= $P(@(GLPAY _"XRKNCLMP T,7)"),"^" ,7)
  61    .I $D(^CH MPAY(XRKNC LMPT,"ZEMC ","MDMTRX" )) S CHEFT CK=""
  62    .;HR-PBM- PHASE 1-Be gin - JBM
  63    .;Added l ogic for S XC
  64    .I $D(^CH MPAY(XRKNC LMPT,"ZEMC ","SXC"))  S CHEFTCK= ""
  65    .;HR-PBM- PHASE 1-En d
  66    .S XRKNPD I=$P(^CHMP AY(XRKNCLM PT,"PDI",1 ,0),"^",1)
  67    .S XRKNJV AL=0
  68    .I ($P(^C HMEDI(I,0) ,"^",5)="" )!($P(^CHM PAY(XRKNCL MPT,0),"^" ,3)="") D  CKVID
  69    .I XRKNJV AL="" K XR KNCLMPT,XR KNPDI,XRKN JVAL,XRKNJ VAL,XRKNVI D Q
  70    .I $D(XRK NVID) I XR KNVID="" K  XRKNCLMPT ,XRKNPDI,X RKNJVAL,XR KNJVAL,XRK NVID Q
  71    .I '$D(XR KNVID) S X RKNVID=$P( ^CHMEDI(I, 0),"^",5)
  72    .I CHEFTC K=1 I '$D( ^CHMVEN(XR KNVID,3))  D  Q  ;NO  EFT INFO
  73    ..S ^CHMZ HOLD("RKN_ 835OUT",XR KNPDI)=XRK NPDI_"^"_X RKNCLMPT_" ^"_I_"^"_X RKNJVAL_"^ "_FILEI_"^ "_CHCDT  ; AEB  8/3/2 005
  74    ..S XRKNV ID=""
  75    ..Q
  76    .I CHEFTC K=1 I $D(^ CHMVEN(XRK NVID,3)) D
  77    ..;Q:'$L( ^CHMVEN(XR KNVID,3))    ;SKD, 7- 31-05 TO F IX THE ERR OR IN THE  ERROR TRAP  ON 7-31-0 5  comment  off on 1/ 3/2006 by  AEB
  78    ..I ^CHMV EN(XRKNVID ,3)="" D   Q  ;AEB 1/ 3/2006
  79    ...S ^CHM ZHOLD("RKN _835OUT",X RKNPDI)=XR KNPDI_"^"_ XRKNCLMPT_ "^"_I_"^"_ XRKNJVAL_" ^"_FILEI_" ^"_CHCDT   ;AEB 1/3/2 006
  80    ...S XRKN VID=""  ;A EB 1/3/200 6
  81    ...Q  ;AE B 1/3/2006
  82    ..S VREC= ^CHMVEN(XR KNVID,3)
  83    ..F TMPI= 1,3 I $P(V REC,"^",TM PI)="" D   Q
  84    ...S ^CHM ZHOLD("RKN _835OUT",X RKNPDI)=XR KNPDI_"^"_ XRKNCLMPT_ "^"_I_"^"_ XRKNJVAL_" ^"_FILEI_" ^"_CHCDT   ;AEB 8/3/2 005
  85    ...S XRKN VID=""
  86    ...Q
  87    .I $D(XRK NVID) I XR KNVID="" K  XRKNCLMPT ,XRKNPDI,X RKNJVAL,XR KNJVAL,XRK NVID Q  ;S TOP IF NO  EFT INFO
  88    .K XRKNCL MPT,XRKNPD I,XRKNJVAL ,XRKNJVAL, XRKNVID
  89    .;1.0 IS  THE INITIA L VERSION  (HIPAA Rea dy LLC)ADD ED HERE TO  ONLY GET  PHARMACY C LAIMS MDMT RX 7/31/06  JPN
  90    .N J,CI,T PID,N1,X1, P1,CHXI,CM XR,NET
  91    .S J=1
  92    .S (CMXI, CMXR,N1,P1 ,NET)=""
  93    .S (N1,X1 ,P1)=0 
  94    .S CI=$P( $G(^CHMEDI (I,1,J,0)) ,"^",1)
  95    .S TPID=0  S TPID=$O (^CHMPAY(C I,"ZEMC",T PID)) Q:TP ID=""
  96    .;HR-PBM- PHASE 1-Be gin
  97    .;Added l ogic to qu it if SXC
  98    .;Q:TPID= "MDMTRX" ;  
  99    .Q:TPID=" MDMTRX"!(T PID="SXC")
  100    .;HR-PBM- PHASE 1-En d
  101    .;1.0 IS  THE INITIA L VERSION  (HIPAA Rea dy LLC) en d of modif ications
  102    .;set the  file numb er and x-r ef
  103    .S $P(^CH MEDI(I,0), "^",6)=FIL EI
  104    .S ^CHMED I("G",FILE I,I)=""
  105    .;set sta tus to "83 5 sent", k ill old x- ref, and s et new x-r ef
  106    .S $P(^CH MEDI(I,0), "^",2)=1
  107    .S ^CHMED I("D",1,I) =""
  108    .K ^CHMED I("D",0,I)
  109    Q
  110    ;
  111   CKVID S XR KNJVAL=$O( ^CHMIMAGE( XRKNPDI,"P -VEN",XRKN JVAL))
  112    ;followin g line wri tes out mi ssing vend or's
  113    I XRKNJVA L="" S ^CH MZHOLD("RK N_835OUT", XRKNPDI)=X RKNPDI_"^" _XRKNCLMPT _"^"_I_"^" _XRKNJVAL_ "^"_FILEI_ "^"_% Q  ; AEB  8/3/2 005
  114    ;followin g line pic kups missi ng vendor' s from ima ge file
  115    S XRKNVID =$P(^CHMIM AGE(XRKNPD I,"P-VEN", XRKNJVAL,0 ),"^",1)
  116    I XRKNVID ="" G CKVI D
  117    S $P(^CHM EDI(I,0)," ^",5)=XRKN VID
  118    S $P(^CHM PAY(XRKNCL MPT,0),"^" ,3)=XRKNVI D
  119    I CHEFTCK =1 I '$D(^ CHMVEN(XRK NVID,3)) D   Q  ;NO E FT INFO
  120    .S ^CHMZH OLD("RKN_8 35OUT",XRK NPDI)=XRKN PDI_"^"_XR KNCLMPT_"^ "_I_"^"_XR KNJVAL_"^" _FILEI_"^" _%  ;AEB   8/3/2005
  121    .S XRKNVI D=""
  122    .Q
  123    S VREC=^C HMVEN(XRKN VID,3)
  124    I CHEFTCK =1 F TMPI= 1,3 I $P(V REC,"^",TM PI)="" D   Q
  125    .S ^CHMZH OLD("RKN_8 35OUT",XRK NPDI)=XRKN PDI_"^"_XR KNCLMPT_"^ "_I_"^"_XR KNJVAL_"^" _FILEI_"^" _%  ;AEB   8/3/2005
  126    .S XRKNVI D=""
  127    Q
  128    ;
  129   FCREATE ;
  130    D SORT
  131    ;S IO="HA C_HFS$:[SC R.000000]8 35_"_FILEI _".TXT"
  132    S FIO="HA C_HFS$:[X1 2OCR.IN]83 5_"_FILEI_ ".TXT"
  133    ;S FIO="H ACFS3"" DNS      Welcome1!" "::D:[FS3B IG.WEBMD.8 35_EXTRACT ]835_"_FIL EI_"_.TXT"
  134    ;DEF01655 4-11/26/13 -SBB use O PEN^%ZISH  to open fi le
  135    ;O FIO:"N WS"
  136    ;SBB 07/3 0/15 DEF01 6554
  137    X "D $SYS TEM.Proces s.SetZEOF( 1)"
  138    S POP=0
  139    S POP=$$O PENFIWR^CH TFLIB9(.FI O,"FIO") I  'POP X "D  $SYSTEM.P rocess.Set ZEOF(0)" Q
  140    D FMSLOOP
  141    ;DEF01655 4-11/26/13 -SBB use C LOSE^%ZISH  to close  file
  142    ;C FIO
  143    D CLOSEF^ CHTFLIB9(F IO,"FIO")
  144    ;SBB 07/3 0/15 DEF01 6554
  145    X "D $SYS TEM.Proces s.SetZEOF( 0)"
  146    Q
  147   SORT ; Sor t FMS_ID's  by payor  and load i nto tmp gl obal
  148    N I,J,CHP ID,CI
  149    K ^TMP($J ,"EDI-835" )
  150    S I=0
  151    F  S I=$O (^CHMEDI(" G",FILEI,I )) Q:'I  D
  152    .S CHPID= ""
  153    .S J=0
  154    .F  S J=$ O(^CHMEDI( I,1,J)) Q: J=""  Q:CH PID]""  D   
  155    ..S CI=$P ($G(^CHMED I(I,1,J,0) ),"^",1)  
  156    ..S CHPID =$$CHPID^C HEDIFU1(CI
  157    ..S CICMP DT="" S:$D (^CHMPAY(C I,0)) CICM PDT=$P(^(0 ),"^",25)  Q:CICMPDT= ""
  158    ..I CICMP DT<3031016  S ^CHMZHO LD("835_PR E-HIPAA_CL M",CI,FILE I,I)=""
  159    .I CHPID] "" S ^TMP( $J,"EDI-83 5",CHPID,I )=""
  160    Q
  161   FMSLOOP ;
  162    N CHPID,F MSI,I,J
  163    K ^TMP($J ,"EDI_CREA TE")
  164    S CHPID=" "
  165    F  S CHPI D=$O(^TMP( $J,"EDI-83 5",CHPID))  Q:CHPID=" "  D
  166    .S FMSI=" ",STSEQ=0
  167    .F  S FMS I=$O(^TMP( $J,"EDI-83 5",CHPID,F MSI)) Q:FM SI=""  D
  168    ..Q:'$D(^ CHMEDI(FMS I,1))  K ^ TMP($J,"ED I_CREATE")
  169    ..S NFILE =CHPID_"_" _FILEI
  170    ..S FMSID =$P(^CHMED I(FMSI,0), "^",1)
  171    ..S VENI= $P(^CHMEDI (FMSI,0)," ^",5)
  172    ..S PLB(1 )=0  ;USED  TO SET PL B ADJUSTME NT IF NEED ED
  173    ..;get fi rst clm in  fms-id to  get clear ing house  and payer_ id
  174    ..;the fi rst clm sh ould be sa me for all  clms for  the fms_id  assuming
  175    ..;that t he fms sor t was done  correctly .  So firs t clm use  used to ge t
  176    ..;fms le vel data.
  177    ..S J=0 S  J=$O(^CHM EDI(FMSI,1 ,J)) Q:J=" "
  178    ..S CI=$P ($G(^CHMED I(FMSI,1,J ,0)),"^",1 )
  179    ..D CLM^C HEDIFU2(CI )
  180    ..S:VENI= "" VENI=$P (CLMLVL(1) ,"^",9)
  181    ..S STSEQ =STSEQ+1  
  182    ..D HDR
  183    ..D BPR
  184    ..D TRN
  185    ..D CLM^C HEDIF2  ;C laim loop
  186    ..D WRT   ;WRIT TRAN SACTION TO  FILE
  187    .Q
  188    Q
  189   HDR ;HDR s egment
  190    S INHDR=" 00000001"
  191    S GRPCTNR ="1"
  192    S ^TMP($J ,"EDI_CREA TE","HDR", 0)=NFILE_" ^"_STSEQ_" ^"_INHDR_" ^"_GRPCTNR _"^"_"0"_" ^"_$$PID^C HEDIFU1(CI )_"^"_$$PR OVID^CHEDI FU1(VENI)_ "^"_$$CHID ^CHEDIFU1( CI)_"^"_"P "_"^"_"NEW "
  193    Q
  194   BPR ;BPT s egment
  195    S (PMETHO D,PYRDFI,P YRACCT,PYR ID,RCVDFI, RCVACCT,PD ATE,CHKEFD T)=""
  196    S PAMT=0, PMETHOD="N ON"  
  197    S PYRID=" 1"_$E($P(^ CHMXTP(3,0 ),"^",2),1 ,9)
  198    S PAMT=+$ P(^CHMEDI( FMSI,0),"^ ",4)
  199    S PMETHOD =$P(CLMLVL (2),"^",10 )
  200    S:PMETHOD ="" PMETHO D="NON"
  201    I PMETHOD ="ACH" D 
  202    .S PYRDFI =111036183
  203    .S PYRACC T=36001200 0
  204    .S PYRID= "1"_$E($P( ^CHMXTP(3, 0),"^",2), 1,9)
  205    .S RCVDFI =$P($G(^CH MVEN(VENI, 3)),"^",1)
  206    .S RCVACC T=$P($G(^C HMVEN(VENI ,3)),"^",3 )
  207    .S CHKEFD T=$$DTOUT^ CHEDIFU1($ P(CLMLVL(1 ),"^",4))
  208    I CHKEFDT ="" D
  209    .S CHKEFD T=$$FMTE^X LFDT(DT,"5 D")
  210    .S CKMONT H=$P(CHKEF DT,"/",1)
  211    .S CKDAY= $P(CHKEFDT ,"/",2)
  212    .F I=1:1: 2-$L(CKMON TH) S CKMO NTH="0"_CK MONTH
  213    .F I=1:1: 2-$L(CKDAY ) S CKDAY= "0"_CKDAY
  214    .S CHKEFD T=$P(CHKEF DT,"/",3)_ CKMONTH_CK DAY
  215    S ^TMP($J ,"EDI_CREA TE","BPR", 0)=NFILE_" ^"_STSEQ_" ^"_PAMT_"^ "_PMETHOD_ "^"_PYRDFI _"^"_PYRAC CT_"^"_PYR ID_"^"_RCV DFI_"^"_RC VACCT_"^"_ CHKEFDT
  216    Q
  217   TRN ;TRN s egment
  218    ;
  219    S ^TMP($J ,"EDI_CREA TE","TRN", 0)=NFILE_" ^"_STSEQ_" ^"_FMSID_" ^"_PYRID_" ^"_$$DTOUT ^CHEDIFU1( $P(CLMLVL( 1),"^",4))
  220    Q
  221   PLB ;PLB s egment
  222    S (PLBPTI D,PLBENDFY ,PLBADJCD, PLBADAMT,P LBRSNCD)=" "
  223    S PLBPTID =$P($G(^CH MVEN(VENI, 0)),"^",3)
  224    S PRENDFY =$$FMTE^XL FDT(DT,"5D ")  ;MUST  BE DEC 31  OF CURRENT  YEAR
  225    S PLBENDF Y=$P(PREND FY,"/",3)_ "1231"
  226    S PLBRSNC D="L6"  ;H ARD CODE T O 'L6'
  227    S PLBADJI D=FMSID  ; HAC FMS ID  NUMBER
  228    ;IF CLAIM  IS UNDER  1.00 = PAI D AMT ELSE  0
  229    S ^TMP($J ,"EDI_CREA TE","PLB", 0)=NFILE_" ^"_STSEQ_" ^"_PLBPTID _"^"_PLBEN DFY_"^"_PL BRSNCD_"^" _PLBADJID_ "^"_PLBTOT
  230    Q
  231    ;
  232    ;/// MODU LE TO COPY  FILE AND  EMAIL UNKN OWN VENDOR S RKN 05/2 6/2004 ///
  233   WBADVID S  XBADVID=0
  234    ;
  235   COPFILE ;S  X=$&ZLIB. %SUBMIT("H AC_HFS$:[D SMMANAG]WE B835.COM", "/NAME=WEB 835_JOB/NO PRINTER/US ER=HACCACH EMGR","835 _"_FILEI_" .TXT")
  236    ;DEF01655 4 SBB 12/0 2/13  - Co nverting f rom DECNET  to FTP.
  237    ;S X=$ZF( -1,"SUBMIT  HAC_HFS$: [DSMMANAG] WEB835.COM  /NAME=WEB 835_JOB/NO PRINTER/US ER=HACCACH EMGR/PARAM ="_"835_"_ FILEI_".TX T")
  238    S FIO="HA C_HFS$:[X1 2OCR.IN]83 5_"_FILEI_ ".TXT"
  239    X ^%ZOSF( "UCI") S U CI=$P(Y,", ",1)
  240    I UCI="HA C" S X=$ZF (-1,"COPY  "_FIO_" HA C_HFS$:[SC R.TEMP_FIL ES]"),FIO= "HAC_HFS$: [SCR.TEMP_ FILES]"_"8 35_"_FILEI _".TXT"
  241    I UCI'="H AC" S X=$Z F(-1,"COPY  "_FIO_" H AC_HFS$:[D SMMANAG.CH AMPVA]"),F IO="HAC_HF S$:[DSMMAN AG.CHAMPVA ]"_"835_"_ FILEI_".TX T"
  242    D FTPFILE ^CHTFLIB9( FIO," DNS     . DNS             ","/fs3big /WEBMD","P UT")
  243    ;
  244   GBADVID S  XBADVID=$O (^CHMZHOLD ("RKN_835O UT",XBADVI D)) G:'XBA DVID MMAUT O
  245    S XREC1(X BADVID)=^C HMZHOLD("R KN_835OUT" ,XBADVID), XPDI=$P(XR EC1(XBADVI D),"^",1), XCLMPT=$P( XREC1(XBAD VID),"^",2 ),XIVAL=$P (XREC1(XBA DVID),"^", 3),XJVAL=$ P(XREC1(XB ADVID),"^" ,4),XFILEI =$P(XREC1( XBADVID)," ^",5),XDTT M=$P(XREC1 (XBADVID), "^",6)
  246    S XCLMNUM =$P(^CHMPA Y(XCLMPT,0 ),"^",1)
  247    S XMAIL(X PDI)=XPDI_ "^"_XCLMNU M_"^"_XIVA L_"^"_XJVA L_"^"_XFIL EI_"^"_XDT TM
  248    G GBADVID
  249   MMAUTO D N OW^%DTC S  VENCT=0
  250    S CHNB=2, ZML(CHNB)= "",ZML(CHN B)="835_"_ FILEI_".TX T"_" is on  shared dr ive Fs3big  on ' DNS     '\WEBMD, r eady to pr ocess!",CH NB=CHNB+1
  251    S CHNB=CH NB+1,ZML(C HNB)="**** ********** ********** ********** ********** ********** ********** ********** *****"
  252    S CHNB=CH NB+2,ZML(C HNB)="",ZM L(CHNB)="U nknown Ven dor or mis sing EFT i nfo ...Cla ims not pr ocessed!", CHNB=CHNB+ 2,ZML(CHNB )="  "
  253    S XPDI=0
  254   MBADV1 S X PDI=$O(XMA IL(XPDI))  G:'XPDI MB ADV2
  255    S CHNB=CH NB+1,ZML(C HNB)="PDI                 = "_$P (XMAIL(XPD I),"^",1)
  256    S CHNB=CH NB+1,ZML(C HNB)="CLAI M NUMBER      = "_$P( XMAIL(XPDI ),"^",2)
  257    S CHNB=CH NB+1,ZML(C HNB)="IVAL ..^CHMEDI( ""D"",0,I  = "_$P(XMA IL(XPDI)," ^",3)
  258    S CHNB=CH NB+1,ZML(C HNB)="VEND OR ID..^CH MIMAGE(PDI ,""P-VEN""   = "_$P(X MAIL(XPDI) ,"^",4)
  259    S CHNB=CH NB+1,ZML(C HNB)="FILE I..$P(^CHM EDIF(0),"" ^"",3)      = "_$P(XM AIL(XPDI), "^",5)
  260    S CHNB=CH NB+1,ZML(C HNB)="DATE  & TIME RE CORDED              =  "_$P(XMAI L(XPDI),"^ ",6)
  261    S CHNB=CH NB+1,CHNB= CHNB+1,ZML (CHNB)="-- ---------- ---------- ---------- ---------- ---------- ---------- ---------- -------"
  262    S VENCT=V ENCT+1
  263    G MBADV1
  264   MBADV2 S C HNB=CHNB+1 ,ZML(CHNB) ="TOTAL NU MBER OF VE NDORS TO C ORRECT "_V ENCT
  265    S XMDUZ=. 5
  266    S XMY("
P II                   ")=""
  267    S XMY("
P II                     ")=""
  268    S XMY(" P I                   ")=""
  269    S XMTEXT= "ZML(",XMS UB="835 Un known Vend ors or Mis sing EFT I nfo"
  270    D ^XMD
  271    ;
  272    K XREC1,X MAIL,XPDI, XCLMPT,XIV AL,XJVAL,X FILEI,XDTT M,X,XBADVI D,XMDUN,XM DUZ,XMZ,ZM L
  273    ;
  274    Q
  275    ;//////// ////////// ////////// ////////// ////////// ///
  276    ;BALANCE  AND WRITE  TO FILE
  277   WRT ;
  278    D SVCBAL
  279    D CLPBAL
  280    D BPRBAL
  281    D PLB
  282    I $D(^TMP ($J,"EDI_C REATE","HD R",0)) D   ;WRITE HDR  
  283    .U FIO W  "HDR^"
  284    .U FIO W  ^TMP($J,"E DI_CREATE" ,"HDR",0), ! Q
  285    I $D(^TMP ($J,"EDI_C REATE","BP R",0)) D  
  286    .U FIO W  "BPR^"
  287    .U FIO W  ^TMP($J,"E DI_CREATE" ,"BPR",0), ! Q
  288    I $D(^TMP ($J,"EDI_C REATE","TR N",0)) D
  289    .U FIO W  "TRN^"
  290    .U FIO W  ^TMP($J,"E DI_CREATE" ,"TRN",0), ! Q
  291    I $D(^TMP ($J,"EDI_C REATE","CL P")) D
  292    .S TI=0 F   S TI=$O( ^TMP($J,"E DI_CREATE" ,"CLP",TI) ) Q:'TI  D
  293    ..U FIO W  "CLP^"
  294    ..U FIO W  ^TMP($J," EDI_CREATE ","CLP",TI ),!
  295    ..I $D(^T MP($J,"EDI _CREATE"," CLPCAS",TI )) D
  296    ...S CLPC TI=0 F  S  CLPCTI=$O( ^TMP($J,"E DI_CREATE" ,"CLPCAS", TI,CLPCTI) ) Q:'CLPCT I  D
  297    ....U FIO  W "CLPCAS ^"
  298    ....U FIO  W ^TMP($J ,"EDI_CREA TE","CLPCA S",TI,CLPC TI),!
  299    ....Q
  300    ..D SVCPT
  301    ...Q
  302    ..Q
  303    .Q
  304    I $D(^TMP ($J,"EDI_C REATE","PL B",0)) D
  305    .U FIO W  "PLB^"
  306    .U FIO W  ^TMP($J,"E DI_CREATE" ,"PLB",0), !
  307    .Q
  308    Q
  309   SVCBAL ;
  310    S (SVCREC ,CASREC,SB AL)=0
  311    Q:'$D(^TM P($J,"EDI_ CREATE","S VC"))
  312    S IVAL=0  F  S IVAL= $O(^TMP($J ,"EDI_CREA TE","SVC", IVAL)) Q:' IVAL  D
  313    .S JVAL=0  F  S JVAL =$O(^TMP($ J,"EDI_CRE ATE","SVC" ,IVAL,JVAL )) Q:'JVAL   D
  314    ..S SVC=^ TMP($J,"ED I_CREATE", "SVC",IVAL ,JVAL)
  315    ..S $P(SV CREC,"^",1 3)=$P(SVCR EC,"^",13) +$P(SVC,"^ ",13)
  316    ..S $P(SV CREC,"^",1 4)=$P(SVCR EC,"^",14) +$P(SVC,"^ ",14)
  317    S IVAL=0  F  S IVAL= $O(^TMP($J ,"EDI_CREA TE","SVCCA S",IVAL))  Q:'IVAL  D
  318    .S JVAL=0  F  S JVAL =$O(^TMP($ J,"EDI_CRE ATE","SVCC AS",IVAL,J VAL)) Q:'J VAL  D
  319    ..S KVAL= 0 F  S KVA L=$O(^TMP( $J,"EDI_CR EATE","SVC CAS",IVAL, JVAL,KVAL) ) Q:'KVAL   D
  320    ...S SVCC AS=^TMP($J ,"EDI_CREA TE","SVCCA S",IVAL,JV AL,KVAL)
  321    ...S $P(C ASREC,"^", 8)=$P(CASR EC,"^",8)+ $P(SVCCAS, "^",8)
  322    ...S $P(C ASREC,"^", 10)=$P(CAS REC,"^",10 )+$P(SVCCA S,"^",10)
  323    ...S $P(C ASREC,"^", 12)=$P(CAS REC,"^",12 )+$P(SVCCA S,"^",12)
  324    ...S $P(C ASREC,"^", 14)=$P(CAS REC,"^",14 )+$P(SVCCA S,"^",14)
  325    ...S $P(C ASREC,"^", 16)=$P(CAS REC,"^",16 )+$P(SVCCA S,"^",16)
  326    ...S $P(C ASREC,"^", 18)=$P(CAS REC,"^",18 )+$P(SVCCA S,"^",18)
  327    ...Q
  328    ..Q
  329    .Q
  330    S CHGAMT= $P(SVCREC, "^",13),AL LAMT=$P(SV CREC,"^",1 4)
  331    S SBAL=CH GAMT-ALLAM T-$P(CASRE C,"^",8)-$ P(CASREC," ^",10)-$P( CASREC,"^" ,12)-$P(CA SREC,"^",1 4)-$P(CASR EC,"^",16) -$P(CASREC ,"^",18)
  332    I SBAL'=0  D  ;SOMET HING?????? ?????????? ?????????? ????
  333    .Q
  334    Q
  335   CLPBAL ;
  336   CLP01 S CL P=0
  337   CLP02 S CL P=$O(^TMP( $J,"EDI_CR EATE","CLP ",CLP)) G: 'CLP CLPEN D
  338    G:'$D(^TM P($J,"EDI_ CREATE","C LP",CLP))  CLP02
  339    S (CASTOT ,SVCTOT,CL P04,CLP03, CBAL)=0
  340    D CCAS
  341    D SCAS
  342    S CLP04=$ P(^TMP($J, "EDI_CREAT E","CLP",C LP),"^",10 )
  343    S CLP03=$ P(^TMP($J, "EDI_CREAT E","CLP",C LP),"^",9)
  344    S CBAL=CL P03-CLP04- SVCTOT-CAS TOT
  345    ;
  346    I CBAL'=0  S PNUM=8  D  S CBAL= 0  ;SOMETH ING??????    ;ADDED P NUM=8 RKN  02/13/2006
  347    .D  I $D( SKFLG) K S KFLG Q
  348    ..S CLMNM =$P(^TMP($ J,"EDI_CRE ATE","CLP" ,CLP),"^", 12) S:CLMN M'="" CLPP T=$O(^CHMP AY("B",CLM NM,0)) Q:' CLPPT
  349    ..I '$D(^ TMP($J,"ED I_CREATE", "CLPCAS",C LP)) I $P( ^CHMPAY(CL PPT,0),"^" ,7)=1 I $P (^CHMPAY(C LPPT,"COMM ON"),"^",8 )'="" D  Q   ;IF NO C LAIM LVL A DJ & TOS =  INPATIENT  & DRG  CL AIM LA3860 3
  350    ...S TCLM ID=$P(^TMP ($J,"EDI_C REATE","CL P",CLP),"^ ",3)
  351    ...S ^TMP ($J,"EDI_C REATE","CL PCAS",CLP, NWCCAS)=NF ILE_"^"_ST SEQ_"^"_TC LMID_"^"_C LMNM_"^"_" OA"_"^"_23 _"^"_CBAL_ "^^^^^^^^^ ^"
  352    ...S SKFL G=""
  353    ...Q
  354    ..Q:'$D(^ TMP($J,"ED I_CREATE", "CLPCAS",C LP))
  355    ..S NWCCA S=0 K SKFL G
  356    ..Q
  357   CLP03 ..S  NWCCAS=$O( ^TMP($J,"E DI_CREATE" ,"CLPCAS", CLP,NWCCAS )) Q:'NWCC AS
  358    ..I $P(^T MP($J,"EDI _CREATE"," CLPCAS",CL P,NWCCAS), "^",5)'="P I" G CLP03
  359    ..S $P(^T MP($J,"EDI _CREATE"," CLPCAS",CL P,NWCCAS), "^",7)=$P( ^TMP($J,"E DI_CREATE" ,"CLPCAS", CLP,NWCCAS ),"^",7)+C BAL
  360    ..S SKFLG =""
  361    ..Q
  362    .S NWCCAS =9999
  363    .S NWCCAS =$O(^TMP($ J,"EDI_CRE ATE","CLPC AS",CLP,NW CCAS),-1)
  364    .S NWCCAS =NWCCAS+1
  365    .S TCLMID =$P(^TMP($ J,"EDI_CRE ATE","CLP" ,CLP),"^", 3)
  366    .S TCLNUM =$P(^TMP($ J,"EDI_CRE ATE","CLP" ,CLP),"^", 12)
  367    .;
  368    .;XXXXXXX XXXXXXXXXX XXXXXXXXXX XXXXXXXXXX XXXXXXXXXX XXXXXXXXXX XX
  369    .S RCNT=- 1
  370   RK2 .;///S TART MODIF IED/ADDED  CODE 02/13 /2006 RKN
  371    .;S ^TMP( $J,"EDI_CR EATE","CLP CAS",CLP,N WCCAS)=NFI LE_"^"_STS EQ_"^"_TCL MID_"^"_TC LNUM_"^"_" PI"_"^"_3_ "^"_CBAL_" ^^^^^^^^^^ "  ;REMARK ED OUT 02/ 13/2006 RK N
  372    .S RCNT=$ O(^TMP($J, "EDI_CREAT E","CLPCAS ",CLP,RCNT )) Q:'RCNT
  373    .;
  374   RK3 .;***  TEST FOR 6  OCCURANCE S, IF NOT  6 WRITTEN,  THEN QUIT  ***
  375    .I $D(^TM P($J,"EDI_ CREATE","C LPCAS",CLP ,1)) I $P( ^TMP($J,"E DI_CREATE" ,"CLPCAS", CLP,1),"^" ,5)="PI" I  $P(^TMP($ J,"EDI_CRE ATE","CLPC AS",CLP,1) ,"^",16)'= "" Q
  376    .;
  377   RK4 .;****  CHECK FOR  FIRST OCC URANCE *** *
  378    .I $D(^TM P($J,"EDI_ CREATE","C LPCAS",CLP ,RCNT)) I  $P(^TMP($J ,"EDI_CREA TE","CLPCA S",CLP,RCN T),"^",5)' ="PI" I $P (^TMP($J," EDI_CREATE ","CLPCAS" ,CLP,1),"^ ",5)'="PI"  D  G RK2
  379    ..S ^TMP( $J,"EDI_CR EATE","CLP CAS",CLP,1 )=NFILE_"^ "_STSEQ_"^ "_TCLMID_" ^"_TCLNUM_ "^"_"PI"_" ^"_3_"^"_C BAL_"^^^^^ ^^^^^" Q
  380    .;
  381   RK5 .;****  CHECK FOR  2 THROUGH  6 OCCURAN CES ****
  382    .I $D(^TM P($J,"EDI_ CREATE","C LPCAS",CLP ,1)) I $P( ^TMP($J,"E DI_CREATE" ,"CLPCAS", CLP,1),"^" ,PNUM)=""  D  S PNUM= PNUM+2 G R K2
  383    ..S CBAL= $P(^TMP($J ,"EDI_CREA TE","CLPCA S",CLP,RCN T),"^",7)  S $P(^TMP( $J,"EDI_CR EATE","CLP CAS",CLP,1 ),"^",PNUM )="3" S $P (^TMP($J," EDI_CREATE ","CLPCAS" ,CLP,1),"^ ",PNUM+1)= CBAL K ^TM P($J,"EDI_ CREATE","C LPCAS",CLP ,RCNT) Q
  384    .;
  385    .;///END  MODIFIED/A DDED CODE  02/13/2006  RKN
  386    .;XXXXXXX XXXXXXXXXX XXXXXXXXXX XXXXXXXXXX XXXXXXXXXX XXXXXXXXXX XX
  387    .;
  388    .Q
  389    G CLP02
  390    ;
  391    ;
  392    ;
  393   CCAS S CCA S=0
  394   CLP11 S CC AS=$O(^TMP ($J,"EDI_C REATE","CL PCAS",CLP, CCAS)) Q:' CCAS
  395    S CASREC= ^TMP($J,"E DI_CREATE" ,"CLPCAS", CLP,CCAS)
  396    S CASTOT= CASTOT+$P( CASREC,"^" ,7)+$P(CAS REC,"^",9) +$P(CASREC ,"^",11)
  397    S CASTOT= CASTOT+$P( CASREC,"^" ,13)+$P(CA SREC,"^",1 5)+$P(CASR EC,"^",17)
  398    G CLP11
  399   SCAS S SVC =0
  400   CLP31 S SV C=$O(^TMP( $J,"EDI_CR EATE","SVC ",CLP,SVC) ) Q:'SVC
  401    G:'$D(^TM P($J,"EDI_ CREATE","S VCCAS")) C LP31
  402    S SVCCAS= 0
  403   CLP51 S SV CCAS=$O(^T MP($J,"EDI _CREATE"," SVCCAS",CL P,SVC,SVCC AS)) G:'SV CCAS CLP31
  404    S SVCREC= ^TMP($J,"E DI_CREATE" ,"SVCCAS", CLP,SVC,SV CCAS)
  405    S SVCTOT= SVCTOT+$P( SVCREC,"^" ,8)+$P(SVC REC,"^",10 )+$P(SVCRE C,"^",12)
  406    S SVCTOT= SVCTOT+$P( SVCREC,"^" ,14)+$P(SV CREC,"^",1 6)+$P(SVCR EC,"^",18)
  407    G CLP51
  408   CLPEND ;
  409    Q
  410   BPRBAL ;
  411    S CLP04TO T=0,PLBTOT =0
  412    S BPR02=$ P(^TMP($J, "EDI_CREAT E","BPR",0 ),"^",3)
  413    S IVAL=0  F  S IVAL= $O(^TMP($J ,"EDI_CREA TE","CLP", IVAL)) Q:' IVAL  D
  414    .S CLP04T OT=CLP04TO T+$P(^TMP( $J,"EDI_CR EATE","CLP ",IVAL),"^ ",10)
  415    .Q
  416    S PLBTOT= CLP04TOT-B PR02
  417    I PLBTOT' =0 D  ;SOM ETHING???? ?????????? ?????????? ?????
  418    .Q
  419    Q
  420   SVCPT ;PRI NT SERVICE  LINE, SER VICE LINE  CAS AND SE RVICE LINE  LQ
  421    I $D(^TMP ($J,"EDI_C REATE","SV C",TI)) D
  422    .S TII=0  F  S TII=$ O(^TMP($J, "EDI_CREAT E","SVC",T I,TII)) Q: 'TII  D
  423    ..U FIO W  "SVC^"
  424    ..U FIO W  ^TMP($J," EDI_CREATE ","SVC",TI ,TII),!
  425    ..I $D(^T MP($J,"EDI _CREATE"," SVCCAS",TI ,TII)) D
  426    ...S TIII =0 F  S TI II=$O(^TMP ($J,"EDI_C REATE","SV CCAS",TI,T II,TIII))  Q:'TIII  D
  427    ....U FIO  W "SVCCAS ^"
  428    ....U FIO  W ^TMP($J ,"EDI_CREA TE","SVCCA S",TI,TII, TIII),!
  429    ....Q
  430    ..I $D(^T MP($J,"EDI _CREATE"," SVCLQ",TI, TII)) D
  431    ...U FIO  W "SVCLQ^"
  432    ...U FIO  W ^TMP($J, "EDI_CREAT E","SVCLQ" ,TI,TII),!
  433    ...Q
  434    ..Q
  435    .Q
  436