67. EPMO Open Source Coordination Office Redaction File Detail Report

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

67.1 Files compared

# Location File Last Modified
1 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHLCR79X.m Mon Nov 5 16:39:18 2018 UTC
2 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHLCR79X.m Mon Nov 5 17:41:47 2018 UTC

67.2 Comparison summary

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

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

67.4 Active regular expressions

No regular expressions were active.

67.5 Comparison detail

  1   CHLCR79X ; HAC/AHJ;PU LL DATA FO R MILLIMAN  SEATTLE A CTUARY BUD GET
  2    ;;V1.0
  3    ;001 OLD  ROUTINE NA ME WAS ZAL CR79X
  4    ;SEARCH C LAIMS FILE  FOR DATE  RANGE OUTP UT CLAIM
  5    ;OUTPUT S PONSOR AND  BENE POIN TERS NEXT  ROUTINE PU LL DATA AN D OUTPUT F ILES
  6    ;
  7    ; MODIFIC ATIONS         CR
  8    ; PN 09-1 9-2007                           DEV003074- 01
  9    ; IDENTIF IED BY IDE NTIFIER 00 1
  10    ;
  11    S U="^"
  12   CHAMPVA ;
  13    S (AGE18, CNT109,TOT DFN,TOTCNT ,NOCLM,NOC CNT,SBCNT, CNT,PCNT,N OAECNT,YAE CNT)=0
  14    S (NOZIPC NT,ICNT,DF NCNT,TOTDF N1,BICNT,B CNT,FMPCNT ,YES18CNT, NO18CNT)=0
  15    S (SPONCN T,DIAGCD,P ROCCD,NDCC ODE,DESC)= 0
  16    S SWYESCL M=0
  17    S T=$C(9)
  18    S PG=1
  19    S DFN=0,U ="^"
  20    ;-------- -----SPONS OR
  21    ;S FIO="H ACFS3"" DNS     decnet HAC dec741!"": :D:[FS3BIG ]CR794SPON SOR.TXT"
  22    ;O FIO C  FIO:"D"
  23    ;O FIO:"N WS"
  24    ;-------- ------BENE FICIARY
  25    ;S FIO1=" HACFS3"" DNS     decnet HAC dec741!"": :D:[FS3BIG ]CR794BENE FICIARY.TX T"
  26    ;O FIO1 C  FIO1:"D"
  27    ;O FIO1:" NWS"
  28    ;-------- ---------C LAIMS
  29    ;S FIO2=" HACFS3"" DNS     decnet HAC dec741!"": :D:[FS3BIG ]CR794CLAI MS.TXT"
  30    ;O FIO2 C  FIO2:"D"
  31    ;O FIO2:" NWS"
  32    K ^CHMZHO LD("NAME-A DD794")
  33    K ^CHMZHO LD("FMP794 ")
  34    K ^CHMZHO LD("NO18CL AIM794")
  35    K ^CHMZHO LD("YES18C LAIM794")
  36    K ^CHMZHO LD("NOTELI G794")
  37    K ^CHMZHO LD("SB794" )
  38    K ^CHMZHO LD("FMP794 ")
  39    K ^CHMZHO LD("NOCLAI M794")
  40    K ^CHMZHO LD("AGE187 94")
  41    K ^CHMZHO LD("BAD-ST ATECODE794 ")
  42    K ^CHMZHO LD("MILLIM ANCLAIMS")
  43    K ^CHMZHO LD("MILLIM ANDFNBFN")
  44    K ^CHMZHO LD("MILLIM ANDFNBFN")
  45    K ^CHMZHO LD("MILLIM ANSPON")
  46    K ^CHMZHO LD("MILLIM ANBENE")
  47    K ^CHMZHO LD("MILLIM AN")         ;001 NEE D TO SEE A BOUT MAYBE  NOT DELET ING THIS S TORAGE GLO BAL
  48    ;
  49   A1 ;
  50    ;FIND TOD AYS DATE F OR AGE TES T
  51    D NOW^%DT C S RUNTIM E=%
  52    S Y=$E(RU NTIME,1,7)
  53    S CHDATE= Y
  54    ;   18 MO NTHS
  55    S X1=CHDA TE S X2=-5 48 D C^%DT C S STRDAT =X
  56    ;  STRDAT  = Start D ate
  57    S STRDAT= 3040930
  58    S ENDDAT= 3060101
  59    ;  CHDATE  = Todays  Date
  60    S TODAY=C HDATE
  61    S DAT18=S TRDAT
  62    ;
  63    G START
  64    ;
  65    ;      
  66    ;
  67    D GETDFN, END
  68    Q
  69    ;
  70    ;
  71    ; ALL ELI GIBLE/ACTI VE BENE'S  ON TODAY
  72    ;******** ********** ********** ********** ********** *****
  73    ; CHAMPVA  BENE FILE
  74   GETDFN S D FN=$O(^AHC HVA(DFN))  Q:'DFN
  75    S TOTDFN= TOTDFN+1
  76    G:$D(^AHC HVA("FMP", DFN)) FMP
  77    ;G:'$D(^A HCHVA(DFN, 100)) GETD FN
  78    S TOTDFN1 =TOTDFN1+1
  79    S BFN=0
  80   GETBFN S B FN=$O(^AHC HVA(DFN,10 0,BFN)) G: 'BFN NODFN 100
  81    S BICNT=B ICNT+1
  82    ; ELIMINA TE SPINA B IFIDA
  83    G:$D(^AHC HVA("SB",D FN,BFN)) S B
  84    ;
  85    G:'$D(^AH CHVA(DFN,1 00,BFN,0))  GETDFN
  86    G:'$D(^AH CHVA(DFN,1 00,BFN,1))  GETDFN
  87    W !,DFN,"  ",BFN
  88    ;
  89   CLAIMS ;
  90    ;
  91   C12 ;NEED  TO FIND CL AIMS FROM  START DATE  TO TODAY  FOR THIS B ENE
  92    ;
  93   L32 S CHDF NI=$O(^CHM DFN("B",DF N,0)) G NO ICNT:'CHDF NI
  94    ;S CHDFNJ =$O(^CHMDF N(CHDFNI,1 00,"B",BFN ,0)) G GET DFN:'CHDFN J
  95    S CHDFNJ= $O(^CHMDFN (CHDFNI,10 0,"B",BFN, 0)) G NOCL M:'CHDFNJ
  96    ;S CHDFNK =99999999
  97    S CHDFNK= 0 ;START A T FRONT
  98   LOOP2 ;W ! ,"   LOOP    ",DFN,"    =  ",CHD FNK
  99    ;S CHDFNK =$O(^CHMDF N(CHDFNI,1 00,CHDFNJ, 100,CHDFNK ),-1) G:'C HDFNK NOCL M
  100    S CHDFNK= $O(^CHMDFN (CHDFNI,10 0,CHDFNJ,1 00,CHDFNK) ) G:'CHDFN K SWITCH
  101    G:$D(^CHM DFN(CHDFNI ,100,CHDFN J,100,CHDF NK,0)) MAI N2
  102    G L32
  103   MAIN2 ;
  104    S CI=^CHM DFN(CHDFNI ,100,CHDFN J,100,CHDF NK,0)
  105    G LOOP2:' $D(^CHMPAY (CI,0))
  106    ;
  107    ;CONVERT  PDI TO CLA IM FILED D ATE
  108    S PDIJ=""
  109    S PDIJ=$O (^CHMPAY(C I,"PDI","B ",PDIJ),-1 )
  110    G:PDIJ=""  LOOP2
  111    ;W !,DFND ATA
  112    S TFMDT=$ $PDIJULFM^ CHMFPDI2(P DIJ)
  113    ;
  114    S CTYP=0
  115    S PDIIN=$ E(PDIJ,8,9 )
  116    I PDIIN=0 4 S CTYP=" CITI"
  117    I PDIIN=9 8 S CTYP=" CMOP"
  118    ; ******* ********** *********
  119    G:TFMDT<3 041001 LOO P2 ;NO CLA IMS LESS T HAN OCT 1,  2004
  120    ;G:TFMDT> 3060131 GE TBFN ;REST  OF CLAIMS  ARE OVER  JAN 1, 200 6
  121    G:TFMDT>3 060131 GET BFN ;REST  OF CLAIMS  ARE OVER F EB 28, 200 7
  122   START ;
  123    S CHCLMI= "IM00000"
  124    S U="^"
  125    S (CHCLM, CNT,DFN)=0
  126    D GETI,EN D
  127    Q
  128   GETI ;
  129    S CHCLMI= $O(^CHMPAY ("B",CHCLM I))
  130    S CHCLMII D=0
  131   GETJ S CHC LMIID=$O(^ CHMPAY("B" ,CHCLMI,CH CLMIID)) G :'CHCLMIID  GETI
  132    G:'$D(^CH MPAY(CHCLM IID,0)) GE TI
  133    ;
  134   GETDT ;
  135    S CLDATA= ^CHMPAY(CH CLMIID,0)
  136    S PDDAT=$ P(CLDATA,U ,25)
  137    S DFN=$P( CLDATA,U,2 1)
  138    S BFN=$P( CLDATA,U,2 2)
  139    S CHK=0                                    ;001 ADDED  FOR GLOBA L CHECK
  140    S MAINDAT =$E(PDDAT, 1,7)
  141    I MAINDAT <3041001 G  GETJ
  142    ;I MAINDA T>3060131  Q
  143    ; 001 CHA NGED DATE  RANGE PER  CR REQUEST
  144    ;I MAINDA T>3070228  Q
  145    I MAINDAT >3070731 D  CLAIMNUM    ;001 ADD ED TO LOOP  THROUGH N EW GLOBAL  STORAGE
  146    ;001 ADDE D TO STORE  DATE IN T EMP GLOBAL  FOR TIME  ISSUES
  147    I CHK=1 Q
  148    I '$D(^CH MZHOLD("MI LLIMAN",CH CLMIID)) S  ^CHMZHOLD ("MILLIMAN ",CHCLMIID ,DFN,BFN)= ""
  149    I CHK=0 G  GETJ ;001  CHECKS TO  SEE IF AL L READY IN  GLOBAL LO OP
  150    Q      ;0 01 WILL QU IT AND RET URN TO STA RT LINE TA G
  151    ;W !,CHCL MI," ",CHC LMIID," ", DFN," ",BF N," ",MAIN DAT
  152   CLAIMNUM ; 001 ADDED  LINE TAG T O LOOP THR OUGH NEW G LOBAL STOR AGE
  153    S CHCLMID =0
  154    F  S CHCL MID=$O(^CH MZHOLD("MI LLIMAN",CH CLMID)) Q: CHCLMID=""   D
  155    . S CI=CH CLMIID,CHK =1,DFN=0,B FN=0
  156    . F  S DF N=$O(^CHMZ HOLD("MILL IMAN",CHCL MID,DFN))  Q:DFN=""   D
  157    .. F  S B FN=$O(^CHM ZHOLD("MIL LIMAN",CHC LMID,DFN,B FN))  Q:BF N=""  D
  158    ... D CLA IMDAT
  159    ... Q
  160    .. Q
  161    Q
  162    ;S PCNT=P CNT+1 I PC NT=10000 W  !,MAINDAT  S PCNT=0
  163   CLAIMDAT ;
  164    ; Accept  Bene with  claims dat e between  start/toda y     ; S  CI=CLAIMNO
  165    I $D(^CHM PAY(CI,"CO MMON")) S  COMMON=$G( ^CHMPAY(CI ,"COMMON") )
  166    S CLMCRED T=$P(^CHMP AY(CI,0)," ^",25)
  167    ;S Y=CLMC REDT D DD^ %DT S CLMC REDT=Y
  168    S CLMCRED T=$$FMTE^X LFDT(CLMCR EDT,"5D")
  169    S TYPE=$P (^CHMPAY(C I,0),"^",7 )
  170    S CLMCMPD T=$P(^CHMP AY(CI,0)," ^",10)
  171    ;S Y=CLMC MPDT D DD^ %DT S CLMC MPDT=Y
  172    S CLMCMPD T=$$FMTE^X LFDT(CLMCM PDT,"5D")
  173    S STATUS= $P(^CHMPAY (CI,0),"^" ,2)
  174    S SRVCDT= $P(^CHMPAY (CI,0),"^" ,8)
  175    ;S Y=SRVC DT D DD^%D T S SRVCDT =Y
  176    S SRVCDT= $$FMTE^XLF DT(SRVCDT, "5D")
  177    ;Inpatien t stays pr ovide from /to dte
  178    I $D(^CHM PAY(CI,"CO MMON")) S  INSTAYUN=$ P(COMMON,U ,6)
  179    I $D(^CHM PAY(CI,"CO MMON")) S  DRG=$P(COM MON,U,8)
  180    I $D(^CHM PAY(CI,"CO MMON")) S  INSTAYOUT= $P(COMMON, U,15)
  181    ;Inpatien t stays pr ovide Outl ier paymen ts
  182    S VPCN=""
  183    I $D(^CHM PAY(CI,7))  S VPCN=$P (^CHMPAY(C I,7),"^",5 )
  184    S VENTIN= $P(^CHMPAY (CI,0),"^" ,3)
  185    I VENTIN< 100000000  S VENPTR=" " S VENTIN =""
  186    I VENTIN' ="" I $D(^ CHMVEN("D" ,VENTIN))  S VENPTR=$ O(^CHMVEN( "D",VENTIN ,I1))
  187    ;
  188    ;
  189    I $D(^CHM PAY(CI,"CO MMON")) S  POS=$P(COM MON,U,2)
  190    ;
  191    I TYPE=1  D INP
  192    I TYPE=2  D OPT
  193    I TYPE=3  D PHARM
  194    I TYPE=4  D DUR
  195    I TYPE=5  D DEN
  196    I TYPE=6  D TRV
  197    ;
  198    S BILLCHG =$P(COMMON ,U,1)
  199    S COMMON1 =$G(^CHMPA Y(CI,"COMM ON",1))
  200    S TOTCHGP D=$P(COMMO N1,U,1)
  201    S TOTALLA MT=$P(COMM ON1,U,7)
  202    ;
  203    ;
  204    ;NEXT 2 L INES BYPAS S REJECTED  CLAIMS
  205    ;001 CHAN GED TO QUI TS TO GO B ACK TO NEW  GLOBAL LO OP
  206    ;G:'$D(^C HMPAY(CI,0 )) GETJ
  207    ;I $P(^CH MPAY(CI,0) ,"^",2)=0  S ^CHMZHOL D("REJECTE DCLAIMS794 ",DFN,BFN, CI)=DFN_U_ BFN_U G GE TJ
  208    Q:'$D(^CH MPAY(CI,0) )
  209    I $P(^CHM PAY(CI,0), "^",2)=0 S  ^CHMZHOLD ("REJECTED CLAIMS794" ,DFN,BFN,C I)=DFN_U_B FN_U Q
  210   CLAIMS4 ;
  211    ;
  212    ;
  213    S:$D(^CHM PAY(CI,1))  TOTOHIPMT =$P(^CHMPA Y(CI,1),"^ ",7)
  214    S AMTBENE PD=$P(COMM ON,U,3)
  215    S:$D(^CHM PAY(CI,1))  DEDMETIND =$P(^CHMPA Y(CI,1),"^ ",24)
  216    S:$D(^CHM PAY(CI,1))  CATMETIND =$P(^CHMPA Y(CI,1),"^ ",27)
  217    ;S AMTPAI D=$P(COMMO N,U,3)
  218    S:$D(^CHM PAY(CI,1))  AMTPAID=$ P(^CHMPAY( CI,1),"^", 1)
  219    ;
  220    ;REMARKS  CODES
  221    ;
  222    S PAYCALM ET=$P(COMM ON,U,16)
  223    ;
  224    ;PAYMENT  METHOD 741 000.0205
  225    ;
  226    S ASSBENI ND=$P(^CHM PAY(CI,0), "^",5)
  227    S DATEPAY =$P(^CHMPA Y(CI,0),"^ ",25)
  228    ;S Y=DATE PAY D DD^% DT S DATEP AY=Y
  229    S DATEPAY =$$FMTE^XL FDT(DATEPA Y,"5D")
  230    ;CONVERT  PDI TO CLA IM FILED D ATE
  231    S PDIJ=""
  232    S PDIJ=$O (^CHMPAY(C I,"PDI","B ",PDIJ),-1 )
  233    I PDIJ=""  S PDIJ=0
  234    S CTYP=0
  235    S PDIIN=$ E(PDIJ,8,9 )
  236    I PDIIN=0 4 S CTYP=" CITI"
  237    I PDIIN=9 8 S CTYP=" CMOP"
  238   CLAIMOUT ;
  239    ;S CTEMP= DFN_U_BFN_ U_CI_U_CLM CREDT_U_TY PE_U_CLMCM PDT_U_STAT US_U_SRVCD T_U_INSTAY UN_U_DRG_U _INSTAYOUT _U_VPCN_U_ VENPTR_U_P OS_U_U_U_U _U_BILLCHG _U_U_TOTCH GPD_U_TOTA LLAMT_U_TO TOHIPMT_U_ AMTBENEPD_ U_DEDMETIN D_U_CATMET IND_U_AMTP AID_U_U_PA YCALMET_U_ U_ASSBENIN D_U_DATEPA Y_U_CTYP_U
  240    S CTEMP=D FN_U_BFN_U _CI_U_CLMC REDT_U_TYP E_U_CLMCMP DT_U_STATU S_U_SRVCDT _U_INSTAYU N_U_DRG_U_ INSTAYOUT_ U_VPCN_U_V ENPTR_U_PO S_U_DIAGCD _U_PROCCD_ U_NDCCODE_ U_DESC_U_B ILLCHG_U_U _TOTCHGPD_ U_TOTALLAM T_U_TOTOHI PMT_U_AMTB ENEPD_U_DE DMETIND_U_ CATMETIND_ U_AMTPAID_ U_U_PAYCAL MET_U_U_AS SBENIND_U_ DATEPAY_U_ CTYP_U
  241    S ^CHMZHO LD("MILLIM ANCLAIMS", DFN,BFN,CI )=DFN_U_BF N_U_CI_U_C LMCREDT_U_ TYPE_U_CLM CMPDT_U_ST ATUS_U_SRV CDT_U_INST AYUN_U_DRG _U_INSTAYO UT_U_VPCN_ U_VENPTR_U _POS_U_DIA GCD_U_PROC CD_U_NDCCO DE_U_DESC_ U_BILLCHG_ U_U_TOTCHG PD_U_TOTAL LAMT_U_TOT OHIPMT_U_A MTBENEPD_U _DEDMETIND _U_CATMETI ND_U_AMTPA ID_U_U_PAY CALMET_U_U _ASSBENIND _U_DATEPAY _U_CTYP_U
  242    ;U FIO2 W  !,CTEMP 
  243    ;W !,DFN, " ",BFN,"  ",CTEMP
  244    S SDFN=DF N ;SAVED F ROM LAST C LAIM FOR U SE IN SPON SOR AND BE NE LOOKUP
  245    S SBFN=BF N
  246    S SWYESCL M=1
  247    S TOTCNT= TOTCNT+1
  248    ;D PUTSPO N
  249    ;D PUTBEN E
  250    S ^CHMZHO LD("MILLIM AN-TRACK-D FN")=DFN
  251    S ^CHMZHO LD("MILLIM ANDFNBFN", DFN,BFN)=" "
  252    ;G GETJ    **001 COM MENTED OUT  TO RETURN  TO NEW GL OBAL LOOP
  253    Q      
  254   PUTSPON ;
  255   OK ;
  256    ;SPONSOR  GET IT
  257    S SWYESCL M=0
  258    G:'$D(^AH CHVA(SDFN, 0)) GETJ
  259    S SPON0=^ AHCHVA(SDF N,0)
  260    S SGEN=$P (SPON0,U,2 )
  261    S SDOB=$P (SPON0,U,3 ) ;DATE
  262    ;S Y=SDOB  D DD^%DT  S SDOB=Y
  263    S SDOB=$$ FMTE^XLFDT (SDOB,"5D" )
  264    S SDOD=$P (SPON0,U,4 ) ;DATE
  265    ;S Y=SDOD  D DD^%DT  S SDOD=Y 
  266    S SDOD=$$ FMTE^XLFDT (SDOD,"5D" )
  267    S SELIGR= $P(SPON0,U ,14)
  268    S SELIGDT =$P(SPON0, U,17) ;DAT E
  269    ;S Y=SELI GDT D DD^% DT S SELIG DT=Y
  270    S SELIGDT =$$FMTE^XL FDT(SELIGD T,"5D")
  271    S ^CHMZHO LD("MILLIM ANSPON",SD FN)=SDFN_U _SGEN_U_SD OB_U_SDOD_ U_SELIGR_U _SELIGDT_U
  272    ;U FIO W  !,STEMP
  273    ;W !,STEM P
  274    S SPONCNT =SPONCNT+1
  275    ;
  276    Q
  277    ;Q:SPONCN T>1001 ;US ED FOR INI TIAL TEST  FILE ONLY
  278    ;
  279    ;END OF S PONSOR OUT PUT
  280    ;BENE GET IT
  281   PUTBENE ;
  282    ;
  283    G:'$D(^AH CHVA(SDFN, 100,SBFN,0 )) GETJ
  284    S BENE0=^ AHCHVA(SDF N,100,SBFN ,0)
  285    G:'$D(^AH CHVA(SDFN, 100,SBFN,1 )) GETJ
  286    S BENE1=^ AHCHVA(SDF N,100,SBFN ,1)
  287    S BDFN=SD FN
  288    S BBFN=SB FN
  289    S BREL=$P (BENE0,U,4 )
  290    S BGEN=$P (BENE0,U,2 )
  291    S BDOB=$P (BENE0,U,3 ) ;DATE
  292    ;S Y=BDOB  D DD^%DT  S BDOB=Y
  293    S BDOB=$$ FMTE^XLFDT (BDOB,"5D" )
  294    S BDOD=$P (BENE0,U,6 ) ;DATE
  295    ;S Y=BDOD  D DD^%DT  S BDOD=Y
  296    S BDOD=$$ FMTE^XLFDT (BDOD,"5D" )
  297    S BZIP=$P (BENE1,U,5 )
  298    S (J1,J2) =""
  299    G:'$D(^AH CHVA(SDFN, 100,BBFN,1 09)) AMEDA
  300    S J1=9999 9999
  301   G2 S J1=$O (^AHCHVA(S DFN,100,BB FN,109,J1) ,-1) Q:'J1
  302    S J2=0
  303    S J2=$O(^ AHCHVA(SDF N,100,BBFN ,109,J1,J2 )) G:'J2 G 2
  304    S:$D(J1)  BBEGELIG=J 1 ;DATE
  305    ;S Y=BBEG ELIG D DD^ %DT S BBEG ELIG=Y
  306    S BBEGELI G=$$FMTE^X LFDT(BBEGE LIG,"5D")
  307    S:$D(J2)  BENDELIG=J 2 ;DATE
  308    ;S Y=BEND ELIG D DD^ %DT S BEND ELIG=Y
  309    S BENDELI G=$$FMTE^X LFDT(BENDE LIG,"5D")
  310    ;
  311   AMEDA ;
  312    I '$D(^AH CHVA(SDFN, 100,BBFN,1 11)) S BME DA="" G AM EDB
  313    S CHMDADT =0
  314    S CHMDADT =$O(^AHCHV A(SDFN,100 ,BBFN,111, CHMDADT))  G:'CHMDADT  AMEDB
  315    S BMEDA=$ P(^AHCHVA( SDFN,100,B BFN,111,CH MDADT,0)," ^",1)
  316    ;S Y=BMED A D DD^%DT  S BMEDA=Y
  317    S BMEDA=$ $FMTE^XLFD T(BMEDA,"5 D")
  318    ;
  319   AMEDB ;
  320    I '$D(^AH CHVA(SDFN, 100,BBFN,1 12)) S BME DB="" G OH ITST
  321    S CHMDBDT =0
  322    S CHMDBDT =$O(^AHCHV A(SDFN,100 ,BBFN,112, CHMDBDT))  G:'CHMDBDT  OHITST
  323    S BMEDB=$ P(^AHCHVA( SDFN,100,B BFN,112,CH MDBDT,0)," ^",1)
  324    ;S Y=BMED B D DD^%DT  S BMEDB=Y
  325    S BMEDB=$ $FMTE^XLFD T(BMEDB,"5 D")
  326   OHITST ;
  327    S OHISW=" N"
  328    S OHIBEG= ""
  329    S CHDFNPT =0
  330   OHINXT ;
  331    S CHDFNPT =$O(^CHMDF N("B",SDFN ,CHDFNPT))  G:'CHDFNP T GETJ
  332       G:'$D( ^CHMDFN(CH DFNPT,0))  NOTOHI
  333       G:'$D( ^CHMDFN(CH DFNPT,100, "B",BFN))  NOTOHI
  334       S CHBF NPT=0
  335       S CHBF NPT=$O(^CH MDFN(CHDFN PT,100,"B" ,BFN,CHBFN PT)) G:'CH BFNPT NOTO HI
  336       G:'$D( ^CHMDFN(CH DFNPT,100, CHBFNPT,2) ) NOTOHI
  337       S CHKV AL=9999999
  338   OHICK1 S C HKVAL=$O(^ CHMDFN(CHD FNPT,100,C HBFNPT,2,C HKVAL),-1)  G:'CHKVAL  NOTOHI
  339       G:'$D( ^CHMDFN(CH DFNPT,100, CHBFNPT,2, CHKVAL,0))  OHICK1
  340       S BBEG OHI=$P(^CH MDFN(CHDFN PT,100,CHB FNPT,2,CHK VAL,0),"^" ,1)
  341       S BEND OHI=$P(^CH MDFN(CHDFN PT,100,CHB FNPT,2,CHK VAL,0),"^" ,2)
  342    ;S Y=BBEG OHI D DD^% DT S BBEGO HI=Y
  343    S BBEGOHI =$$FMTE^XL FDT(BBEGOH I,"5D")
  344    ;S Y=BEND OHI D DD^% DT S BENDO HI=Y
  345    S BENDOHI =$$FMTE^XL FDT(BENDOH I,"5D")
  346   NOTOHI ;
  347    G:'$D(BZI P) NOZIP
  348    I $L(BZIP )>5 I $E(B ZIP,6,6)'= "-" S BZIP =$E(BZIP,1 ,5)_"-"_$E (BZIP,6,9)
  349    ;
  350    S ^CHMZHO LD("MILLIM ANBENE",SD FN,BDFN)=S DFN_U_BBFN _U_BREL_U_ BGEN_U_BDO B_U_BDOD_U _BZIP_U_BB EGELIG_U_B ENDELIG_U_ BMEDA_U_BM EDB_U_BBEG OHI_U_BEND OHI_U
  351    ;U FIO1 W  BTEMP,!
  352    Q
  353    ;
  354    ;END OF B ENEFICIARY  OUTPUT
  355    S YES18CN T=YES18CNT +1
  356    G GETBFN
  357   INP ;
  358    I TYPE=1  D  ;INPAT
  359    .Q:'$D(^C HMPAY(CI," INP-DX",0) )
  360    .S J=0
  361    .S J=$O(^ CHMPAY(CI, "INP-DX",J )) I J=""  Q
  362    .Q:'$D(^C HMPAY(CI," INP-DX",J, 0))
  363    .S OUTDIA G=$P(^CHMP AY(CI,"INP -DX",J,0), U,1)
  364    .S DIAGCD =OUTDIAG
  365    .Q:'$D(^C HMPAY(CI," INP-PROC", J,0))
  366    .S OUTPRO C=$P(^CHMP AY(CI,"INP -PROC",J,0 ),U,1)
  367    .S PROCCD =OUTPROC  
  368    .S DESC=" INP"
  369    .Q
  370    Q
  371   OPT ;
  372    I TYPE=2  D  ;OUTPAT
  373    .Q:'$D(^C HMPAY(CI," OPT-DX",0) )
  374    .S J=0
  375    .S J=$O(^ CHMPAY(CI, "OPT-DX",J )) I J=""  Q
  376    .Q:'$D(^C HMPAY(CI," OPT-DX",J, 0))
  377    .S OUTDIA G=$P(^CHMP AY(CI,"OPT -DX",J,0), U,1)
  378    .S DIAGCD =OUTDIAG
  379    .Q:'$D(^C HMPAY(CI," OPT-PROC", J,0))
  380    .S OUTPRO C=$P(^CHMP AY(CI,"OPT -PROC",J,0 ),U,1)
  381    .S PROCCD =OUTPROC  
  382    .S DESC=" OPT"
  383    .Q
  384    Q
  385   PHARM ;
  386    I TYPE=3  D  ;PHARM
  387    Q:'$D(^CH MPAY(CI,"P HARM",0))
  388    S J=0
  389    S J=$O(^C HMPAY(CI," PHARM",J))  I J="" Q
  390    Q:'$D(^CH MPAY(CI,"P HARM",J,0) )
  391    S NDCCODE =$P(^CHMPA Y(CI,"PHAR M",J,0),U, 2)
  392    ;Q:'$D(^C HMPAY(CI," PHARM",J," RX-DX",1,0 ))
  393    ;S DIAG=^ CHMPAY(CI, "PHARM",J, "RX-DX",1, 0)
  394    S DIAGCD= NDCCODE
  395    S DESC="R XT"
  396    Q
  397   DUR ;
  398    I TYPE=4  D  ;DURABL E
  399    Q:'$D(^CH MPAY(CI,"D ME-DX",0))
  400    S J=0
  401    S J=$O(^C HMPAY(CI," DME-DX",J) ) I J="" Q
  402    Q:'$D(^CH MPAY(CI,"D ME-DX",J,0 ))
  403    S OUTDIAG =$P(^CHMPA Y(CI,"DME- DX",J,0),U ,1)
  404    S DIAGCD= OUTDIAG
  405    Q:'$D(^CH MPAY(CI,"D ME-SUPPLY" ,J,0))
  406    S OUTPROC =$P(^CHMPA Y(CI,"DME- SUPPLY",J, 0),U,1)
  407    S PROCCD= OUTPROC
  408    S DESC="D UR"
  409    Q
  410   DEN ;
  411    I TYPE=5  D  ;DENTAL
  412    Q:'$D(^CH MPAY(CI,"D NT-DX",0))
  413    S J=0
  414    S J=$O(^C HMPAY(CI," DNT-DX",J) ) I J="" Q
  415    Q:'$D(^CH MPAY(CI,"D NT-DX",J,0 ))
  416    S OUTDIAG =$P(^CHMPA Y(CI,"DNT- DX",J,0),U ,1)
  417    S DIAGCD= OUTDIAG
  418    Q:'$D(^CH MPAY(CI,"D NT-PROC",J ,0))
  419    S OUTPROC =$P(^CHMPA Y(CI,"DNT- PROC",J,0) ,U,1)
  420    S PROCCD= OUTPROC  
  421    S DESC="D NT"
  422    Q
  423   TRV ;
  424    I TYPE=6  D  ;TRAVEL
  425    Q:'$D(^CH MPAY(CI,"T RV-DX",0))
  426    S J=0
  427    S J=$O(^C HMPAY(CI," TRV-DX",J) ,0) I J=""  Q
  428    Q:'$D(^CH MPAY(CI,"T RV-DX",J,0 ))
  429    S OUTDIAG =$P(^CHMPA Y(CI,"TRV- DX",J,0),U ,1)
  430    S DIAGCD= OUTDIAG
  431    Q:'$D(^CH MPAY(CI,"T RV-PROC",J ,0))
  432    S OUTPROC =$P(^CHMPA Y(CI,"TRV- PROC",J,0) ,U,1)
  433    S PROCCD= OUTPROC  
  434    S DESC="T RV"
  435    Q
  436   OUTARRAY ;
  437    F K=1:1:J  S VAR=VAR +IDARRAY(K )_U
  438    S ^CHMZHO LD("TEST-A L-794",CI) =VAR
  439    Q
  440   SWITCH ;
  441    I SWYESCL M=1 G PUTS PON
  442    I SWYESCL M=0 G GETB FN
  443    Q
  444   STOP ;
  445    S ^CHMZHO LD("BAD-ST ATECODE794 ",DFN,BFN) =STATE1_U
  446    G GETBFN
  447   NOZIP ;
  448    S NOZIPCN T=NOZIPCNT +1
  449    G GETBFN
  450   NODFN100 ;
  451    S DFNCNT= DFNCNT+1
  452    G GETDFN
  453   NOICNT ;
  454    S ICNT=IC NT+1
  455    G GETDFN
  456   SB ;
  457    ;W !,"SB=  ",DFN," " ,BFN
  458    S SBCNT=S BCNT+1
  459    S ^CHMZHO LD("SB794" ,DFN,BFN)= ""
  460    G GETBFN
  461   FMP ;
  462    S FMPCNT= FMPCNT+1
  463    S ^CHMZHO LD("FMP794 ",DFN)=""
  464    G GETDFN
  465   NO109 ;
  466    S CNT109= CNT109+1
  467    G GETBFN
  468   NOCLM ;
  469    S NOCLM=N OCLM+1
  470    S ^CHMZHO LD("NOCLAI M794",DFN, BFN)=""
  471    G GETBFN
  472   NO18CLM ;
  473    S NO18CNT =NO18CNT+1
  474    ;W !,"NO  CLAIMS 18  MOS                            " ,DFN," ",B FN," ",TFM DT
  475    S ^CHMZHO LD("NO18CL AIM794",DF N,BFN)=""
  476    G GETBFN
  477   NOTELIG ;
  478    ;W !,"          NOT  ELIG DATES       ",DF N," ",BFN, " ",J1," " ,J2
  479    S ^CHMZHO LD("NOTELI G794",DFN, BFN)=""
  480    S NOAECNT =NOAECNT+1
  481    G GETBFN
  482   AGE18 ;
  483    S AGE18=A GE18+1
  484    S ^CHMZHO LD("AGE187 94",DFN,BF N,TAGE)=""
  485    G GETBFN
  486   MISC ;
  487    S T=$C(9)
  488    I STATE'= "" D
  489    .S TMPS=$ P(NAMELAB, U,1)_T_$P( ADDRLAB,U, 1)_T_$P(AD DRLAB,U,2) _T_$P(ADDR LAB,U,3)_" , "_STATE_ "  "_$P(AD DRLAB,U,5) _T
  490    I STATE=" " D
  491    .S COUNTR Y=$P(ADDRL AB,U,13)
  492    .S:COUNTR Y COUNTRY= $P(^DIC(5, COUNTRY,0) ,U,1)
  493    .S TMPS=$ P(NAMELAB, U,1)_T_$P( ADDRLAB,U, 1)_T_$P(AD DRLAB,U,2) _T_COUNTRY _T
  494    U FIO W ! ,TMPS
  495   END ;
  496    ;C FIO
  497    ;C FIO1
  498    ;C FIO2
  499    ;W !,"NOT  ELIGIBLE  = ",NOAECN T
  500    ;W !,"NO  CLAIMS LAS T 18 MONTH S = ",NO18 CNT
  501    ;W !,"NO  CLAIMS EVE R = ",NOCL M
  502    ;W !,"ELI GIBLE BENE S = ",YAEC NT
  503    ;W !,"BAD  ADDRESSES  = ",BCNT
  504    ;W !,"ELI GIBLE W/18  MO CLAIMS  OVER AGE  17 = ",YES 18CNT
  505    W !,"CLAI MS COUNT = ",TOTCNT
  506    ;W !,"OUT PUT COUNT  = ",SPONCN T
  507    K ADDRLAB ,BFN,CHDAT E,CHDFNI,C HDFNJ,CHDF NK,DFN,DFN DATA,FIO,J 1,J2
  508    K NAMELAB ,PCNT,PDIJ ,PG,RUNTIM E,STATE,ST RDAT,T,TFM DT,TMPS,U
  509    ;
  510    Q