147. EPMO Open Source Coordination Office Redaction File Detail Report

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

147.1 Files compared

# Location File Last Modified
1 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMKSMLD.m Mon Nov 5 16:43:58 2018 UTC
2 CPEE_Build9_Sprint27.zip\HAC_CPE_CH CHMKSMLD.m Mon Nov 5 17:49:26 2018 UTC

147.2 Comparison summary

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

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

147.4 Active regular expressions

No regular expressions were active.

147.5 Comparison detail

  1   CHMKSMLD ; HAC/JEH; C HAMPVA CHA MPVA Surve y Mailing  Driver ;11 /07/08
  2    ;;V1.0
  3    ;
  4    ;AGE OVER  18
  5    ;HAVE CLA IMS LAST 9 0 DAYS
  6    ;NO BAD A DDRESS RO  NO DOD
  7    ;
  8   CHAMPVA ;
  9    S (YESCNT ,NOCNT,YCN T,NCNT)=0
  10    S (SW9,BE NCNT,ECNT, IECNT,RCNT ,NRCNT,TCN T,NTCNT,NS CNT,DCNT)= 0
  11    S (SEQNO, TOTCLM,COU NT,SW1,CLM CNT,CLAIM, CNT,TOTCNT ,CCNT)=0
  12    S DFN=0,U ="^"
  13    K ^CHMZHO LD("ACCEPT -CR1276-YE S")
  14    K ^CHMZHO LD("ACCEPT -CR1276-NO ")
  15    K ^CHMZHO LD("CR645Y ESOHI")
  16    K ^CHMZHO LD("CR645N OOHI")
  17    K ^CHMZHO LD("ACCEPT -TRC")
  18    K ^CHMZHO LD("NOT-EL IG-TRC")
  19    K ^CHMZHO LD("ACCEPT -TRC-BU")
  20    K ^CHMZHO LD("NO-CLA IMS-OVER18 -TRC")
  21    K ^CHMZHO LD("NOT-EL IG-6MO-CLA IM-TRC")
  22    K ^CHMZHO LD("ACCEPT -TOTAL-REC ORDS-TRC")
  23    K ^CHMZHO LD("FY03-C LAIMS-TRC" )
  24    K ^CHMZHO LD("TRC122 5-BADADDR" )
  25    K ^CHMZHO LD("TRC122 5-DOD")
  26    ;K ^CHMZH OLD("ACCEP T-TRC1313- UNDER")
  27    S ^CHMZHO LD("BENE-N A-OHI-RAN- LABELS")=" "
  28    ;S FIO="P T1313.DAT"
  29    ;O FIO C  FIO:"D"
  30    ;O FIO:"N WS"
  31    ;
  32    ;S DFN=32 7
  33    ;
  34   A2 ;
  35    ;FIND TOD AYS DATE F OR AGE TES T
  36    D NOW^%DT C S CHDATE =X
  37    S TODAY=C HDATE
  38    ; COMPUTE  90 DAYS
  39    S X1=CHDA TE S X2=-9 0 D C^%DTC  S STRDAT= X
  40    D GETDFN, END
  41    Q
  42    ;******** ********** ********** ********** ********** *****
  43    ;
  44   GETDFN ;
  45    S TOTCNT= TOTCNT+1
  46    ;TEST ONL Y HERE NEX T LINE
  47    ;I TOTCNT =2000 Q
  48    S DFN=$O( ^AHCHVA(DF N)) Q:'DFN
  49    G:'$D(^AH CHVA(DFN,1 00)) GETDF N
  50    S (TFMDT, BFN)=0
  51   GETBFN ;
  52    S BFN=$O( ^AHCHVA(DF N,100,BFN) ) G:'BFN G ETDFN
  53    G:'$D(^AH CHVA(DFN,1 00,BFN,0))  GETBFN
  54    G:'$D(^AH CHVA(DFN,1 00,BFN,109 )) GETBFN
  55    ;W !,DFN, "  ",BFN
  56    S J1=9999 9999
  57   G2 S J1=$O (^AHCHVA(D FN,100,BFN ,109,J1),- 1) G:'J1 G ETBFN
  58    S J2=9999 9999
  59    S J2=$O(^ AHCHVA(DFN ,100,BFN,1 09,J1,J2), -1) G:'J2  G2
  60    ;
  61    ;CHECK FO R DATES OF  ELIGIBILI TY
  62    G:J1>CHDA TE OUT1
  63    G:J2<CHDA TE OUT1
  64    ;
  65    G:'$D(^AH CHVA(DFN,1 00,BFN,0))  GETBFN
  66    G:'$D(^AH CHVA(DFN,1 00,BFN,1))  GETBFN
  67    ;
  68    ;NEXT LIN E CHECK BE GIN/END EL IGIBLE DAT ES
  69    S NAMLAB= ^AHCHVA(DF N,100,BFN, 0)
  70    ;
  71    ;CHECK FO R DATE OF  DEATH
  72    S DOD=$P( NAMLAB,U,6 )
  73    I DOD'=""  G OUT6
  74    S ADDRLAB =^AHCHVA(D FN,100,BFN ,1)
  75    ;
  76    ;CHECK FO R BAD ADDR ESS CODE
  77    S BADADDR =$P(ADDRLA B,U,10)
  78    I BADADDR =0 G OUT5
  79    I BADADDR =2 G OUT5
  80    ;
  81    ;FORMAT S OC SEC NUM BER
  82    S SSN=$P( NAMLAB,U,9 )
  83    S SSN3=$E (SSN,1,3)
  84    S SSN2=$E (SSN,4,5)
  85    S SSN4=$E (SSN,6,9)
  86    S SSN=SSN 3_"-"_SSN2 _"-"_SSN4
  87    ;
  88    ;SAVE TEL EPHONE NUM BER
  89    S PHONE=$ P(ADDRLAB, U,6)
  90    I $E(PHON E,4,4)="-"  S TELENO= PHONE G OK NOW
  91    I $E(PHON E,1,1)="("  S TELENO= PHONE G OK NOW
  92    I $E(PHON E,4,4)=" "  S TELENO= PHONE G OK NOW
  93    I PHONE'= "" I $L(PH ONE)<9 I $ E(PHONE,4, 4)'=("")!( "-") S PPH ONE=$E(PHO NE,1,3)_"- "_$E(PHONE ,4,6)_"-"_ $E(PHONE,7 ,10)
  94    I PHONE'= "" I $E(PH ONE,1,1)'= "(" S PPHO NE=$E(PHON E,1,3)_"-" _$E(PHONE, 4,6)_"-"_$ E(PHONE,7, 10)
  95    I PHONE=" " S PPHONE =""
  96    S TELENO= PPHONE
  97    ;
  98   OKNOW ;
  99    ;CHECK FO R SEX
  100    S SEX=$P( NAMLAB,U,2 )
  101    ;
  102    ;CHECK FO R BAD STAT E ADDRESS    
  103    S STATE=$ P(ADDRLAB, U,4)
  104    I STATE=" " G GETBFN
  105    ;
  106    ;CHECK FO R DATE OF  BIRTH AGE  19 AND OVE R
  107    S DOB=$P( NAMLAB,U,3 )
  108    G:'DOB GE TBFN
  109    S BRTHDAY =DOB
  110    S TAGE=$$ AGE^CHTFLI B(BRTHDAY, TODAY)
  111    I TAGE<20  G GETBFN
  112    ;W !,"    AGE TEST H ERE ",DFN, " ",BFN,"  ",TAGE
  113    ;NEED TO  FIND CLAIM S FROM STA RT DATE TO  TODAY FOR  THIS BENE
  114    ;
  115   L3 S CHDFN I=$O(^CHMD FN("B",DFN ,0)) G GET DFN:'CHDFN I
  116    S CHDFNJ= $O(^CHMDFN (CHDFNI,10 0,"B",BFN, 0)) G GETD FN:'CHDFNJ
  117    S CHDFNK= 99999999
  118   LOOP ;
  119    S CHDFNK= $O(^CHMDFN (CHDFNI,10 0,CHDFNJ,1 00,CHDFNK) ,-1) G:'CH DFNK CKEND
  120    G:$D(^CHM DFN(CHDFNI ,100,CHDFN J,100,CHDF NK,0)) MAI N
  121    G L3
  122   MAIN ;
  123    S DFNDATA =^CHMDFN(C HDFNI,100, CHDFNJ,100 ,CHDFNK,0)
  124    G LOOP:'$ D(^CHMPAY( DFNDATA,0) )
  125    ;CONVERT  PDI TO CLA IM FILED D ATE
  126    S PDIJ=""
  127    S PDIJ=$O (^CHMPAY(D FNDATA,"PD I","B",PDI J),-1)
  128    G:PDIJ=""  LOOP
  129    S TFMDT=$ $PDIJULFM^ CHMFPDI2(P DIJ)
  130    ;
  131    I TFMDT<S TRDAT G OU T3 ;CLAIMS  LAST
  132    ;
  133   BENWITH ;B ENE WITH C LAIMS LAST  90 DAYS,  OVER 19 AG E, BYPASS  BAD ADDRES S AND DOD
  134    ;
  135    S OHISW=" N"
  136    S OHIBEG= ""
  137    S CHDFNPT =0
  138    S CHDFNPT =$O(^CHMDF N("B",DFN, CHDFNPT))  G:'CHDFNPT  NOTOHI
  139    G:'$D(^CH MDFN(CHDFN PT,0)) NOT OHI
  140    G:'$D(^CH MDFN(CHDFN PT,100,"B" ,BFN)) NOT OHI
  141    S CHBFNPT =0
  142    S CHBFNPT =$O(^CHMDF N(CHDFNPT, 100,"B",BF N,CHBFNPT) ) G:'CHBFN PT NOTOHI
  143    G:'$D(^CH MDFN(CHDFN PT,100,CHB FNPT,2)) N OTOHI
  144    S CHKVAL= 99999
  145   OHICK1 S C HKVAL=$O(^ CHMDFN(CHD FNPT,100,C HBFNPT,2,C HKVAL),-1)  G:'CHKVAL  NOTOHI
  146    G:'$D(^CH MDFN(CHDFN PT,100,CHB FNPT,2,CHK VAL,0)) OH ICK1
  147    S OHIBEG= $P(^CHMDFN (CHDFNPT,1 00,CHBFNPT ,2,CHKVAL, 0),"^",1)
  148    S OHIEND= $P(^CHMDFN (CHDFNPT,1 00,CHBFNPT ,2,CHKVAL, 0),"^",2)
  149    S OHICODE =$P(^CHMDF N(CHDFNPT, 100,CHBFNP T,2,CHKVAL ,0),"^",3)
  150    I OHICODE =1 G NOTOH I
  151    I OHICODE =8 G NOTOH I
  152    ;
  153    G:'$D(OHI BEG) NOTOH I
  154    I OHIBEG= "" I OHIEN D="" G NOT OHI
  155    G:OHIBEG> CHDATE NOT OHI
  156    I OHIEND= "" S OHISW ="Y" G NEX TCK
  157    G:OHIEND< CHDATE NOT OHI
  158   NOTOHI S O HISW="N"
  159   NEXTCK ;
  160    D ACCEPT
  161    S TOTCLM= 0
  162    G GETBFN
  163    Q
  164   ACCEPT ;
  165    Q:$$CHKPH RM^CHMKSML D(DFN,BFN, STRDAT)=1    ;DO NOT  ACCEPT IF  BENE ONLY  HAS PHARMA CY CLAIMS
  166    ;USE THIS  NAME AND  ADDRESS TO  BE PUT IN  FILE TO B E USED FOR  RANDOM
  167    S SEQNO=S EQNO+1
  168    ;S ^CHMZH OLD("ACCEP T-TRC",SEQ NO)=DFN_U_ BFN_U_SSN_ U_SEX_U_OH ISW_U_TELE NO_T_TAGE_ T_
  169    ;S ^CHMZH OLD("ACCEP T-TRC-BU", SEQNO)=DFN _U_BFN_U_S SN_U_SEX_U _OHISW_U_T ELENO_T_TA GE_T_
  170    S STATE=$ P(ADDRLAB, U,4)
  171    I STATE=" " Q
  172    G GETBFN: '$D(^DIC(5 ,STATE,0))
  173    S:STATE S TATE=$P(^D IC(5,STATE ,0),U,2)
  174    S (ZIP,ZI PZ)=""
  175    S ZIPZ=$P (ADDRLAB,U ,5)
  176    I $L(ZIPZ )>5 S ZIP1 =$E(ZIPZ,1 ,5) S ZIP2 =$E(ZIPZ,6 ,9) S ZIPZ =ZIP1_"-"_ ZIP2
  177    S T=$C(9)
  178    S ADDR1=$ P(NAMLAB,U ,1)
  179    S ADDR2=$ P(ADDRLAB, U,1)
  180    S ADDR3=$ P(ADDRLAB, U,2)
  181    S ADDR4=$ P(ADDRLAB, U,12)
  182    S ADDR5=$ P(ADDRLAB, U,3)
  183    S ADDR6=S TATE
  184    S ADDR7=Z IPZ
  185    S TMP=ADD R1_T_ADDR2 _T_ADDR3_T _ADDR4_T_A DDR5_T_ADD R6_T_ADDR7 _T
  186    ;NEXT TWO  FILE ARE  FOR QA TO  VERIFY DAT A
  187    I OHISW=" Y" S YESCN T=YESCNT+1  S ^CHMZHO LD("CR645Y ESOHI",DFN ,BFN,YESCN T)=OHICODE _U_OHIBEG_ U_OHIEND_U _CHDFNPT_U _CHBFNPT_U _CHKVAL_U
  188    I OHISW=" N" S NOCNT =NOCNT+1 S  ^CHMZHOLD ("CR645NOO HI",DFN,BF N,NOCNT)=O HICODE_U_O HIBEG_U_OH IEND_U_CHD FNPT_U_CHB FNPT_U_CHK VAL_U
  189    ;NEXT TWO  FILES ARE  FOR PULLI NG 300 RAN DOM BENE'S  IN ROUTIN ES ZALC645 Y AND ZALC 645N
  190    I OHISW=" Y" S ^CHMZ HOLD("ACCE PT-CR1276- YES",YESCN T)=DFN_U_B FN_U_ADDR1 _U_TELENO_ U_ADDR2_U_ ADDR3_U_AD DR4_U_ADDR 5_U_ADDR6_ U_ADDR7_U_ SEX_U_SSN_ U_OHICODE_ U_TAGE_U
  191    I OHISW=" N" S ^CHMZ HOLD("ACCE PT-CR1276- NO",NOCNT) =DFN_U_BFN _U_ADDR1_U _TELENO_U_ ADDR2_U_AD DR3_U_ADDR 4_U_ADDR5_ U_ADDR6_U_ ADDR7_U_SE X_U_SSN_U_ OHISW_U_TA GE_U
  192    ;
  193    ;W !,DFN, " ",BFN,"  ",OHISW
  194    S OHISW=" N"
  195    ;
  196    Q
  197   CKEND ;
  198    S ^CHMZHO LD("NO-CLA IMS-OVER18 -TRC",DFN, BFN)=""
  199    I TOTCLM= 0 S SW=0 G  GETBFN
  200    S SW1=0 G  OUT4
  201    Q
  202   OUT1 ;NOT  ELIG
  203    S ^CHMZHO LD("NOT-EL IG-TRC",DF N,BFN,J1,J 2)=""
  204    G GETBFN
  205    ;
  206   OUT2 ;NOT  ELIG 6 MO  BEFORE 5TH  OLDEST CL AIM OVER 1 8 MON
  207    S ^CHMZHO LD("NOT-EL IG-6MO-CLA IM-TRC",DF N,BFN)=""
  208    G GETBFN
  209   OUT3 ;CLAI MS FY 03
  210    S ^CHMZHO LD("FY03-C LAIMS-TRC" ,DFN,BFN,D FNDATA,PDI J,TFMDT)=" "
  211    G GETBFN
  212   OUT4 ; COU NT CLAIMS
  213    S ^CHMZHO LD("FY03-T OTCLAIMS-9 09",DFN,BF N,TOTCLM,T FMDT)=""
  214    S TOTCLM= 0
  215    G GETBFN
  216   OUT5 ;
  217    S ^CHMZHO LD("TRC122 5-BADADDR" ,DFN,BFN)= BADADDR
  218    G GETBFN
  219   OUT6 ;
  220    S ^CHMZHO LD("TRC122 5-DOD",DFN ,BFN)=DOD
  221    G GETBFN
  222   BYPASS ;
  223    G GETBFN
  224    Q
  225   WRITEIT ;
  226    ;W !,J1,"   ",J2,"CL AIM DATE=" ,TFMDT," C LAIM COUNT =",COUNT,"  DFN=",DFN ," BFN= ", BFN
  227    G GETBFN
  228   END ;
  229    ;
  230    S ^CHMZHO LD("ACCEPT -TOTAL-REC ORDS-CR127 6YES")=YES CNT
  231    S ^CHMZHO LD("ACCEPT -TOTAL-REC ORDS-CR127 6NO")=NOCN T
  232    D ^CHMKSM LY
  233    D ^CHMKSM LN
  234    S Y=CHDAT E D DD^%DT  S PTODAYD T=Y
  235    ;K ADDRLA B,BFN,CHDA TE,CHDFNI, CHDFNJ,CHD FNK,DFN,DF NDATA,FIO, J1,J2
  236    ;K NAMELA B,PCNT,PDI J,PG,RUNTI ME,STATE,S TRDAT,T,TF MDT,TMPS,U
  237    S CNTZ=1, ^CHMZHOLD( $J,"BENERA N-TEXTMESS 1",CNTZ)=" ",CNTZ=CNT Z+1
  238    S ^CHMZHO LD($J,"BEN ERAN-TEXTM ESS1",CNTZ )="******* ********** ********** ********** ********** ***",CNTZ= CNTZ+1
  239    S ^CHMZHO LD($J,"BEN ERAN-TEXTM ESS1",CNTZ )="  BENEF ICIARY NAM E AND ADDR ESS LIST          ",C NTZ=CNTZ+1     
  240    S ^CHMZHO LD($J,"BEN ERAN-TEXTM ESS1",CNTZ )="  OHI R ANDOM COUN T HAS  COM PLETED   " ,CNTZ=CNTZ +1
  241    S ^CHMZHO LD($J,"BEN ERAN-TEXTM ESS1",CNTZ )="                                                                                                               ",CNTZ =CNTZ+1
  242    S ^CHMZHO LD($J,"BEN ERAN-TEXTM ESS1",CNTZ )="TODAYS  DATE="_PTO DAYDT,CNTZ =CNTZ+1
  243    S ^CHMZHO LD($J,"BEN ERAN-TEXTM ESS1",CNTZ )="YES OHI  COUNT="_Y CNT,CNTZ=C NTZ+1
  244    S ^CHMZHO LD($J,"BEN ERAN-TEXTM ESS1",CNTZ )="NO OHI  COUNT="_NC NT,CNTZ=CN TZ+1
  245    S ^CHMZHO LD($J,"BEN ERAN-TEXTM ESS1",CNTZ )=" (OUTPU T FILES ON  FS3BIG)                                            ", CNTZ=CNTZ+ 1
  246    S ^CHMZHO LD($J,"BEN ERAN-TEXTM ESS1",CNTZ )="YES OHI  FILE NAME /ADDRESS O N FS3BIG=C R1276BENEY ESNA.XLS", CNTZ=CNTZ+ 1
  247    S ^CHMZHO LD($J,"BEN ERAN-TEXTM ESS1",CNTZ )="YES OHI  FILE INFO  ON FS3BIG =CR1276BEN EYESINFO.T XT",CNTZ=C NTZ+1
  248    S ^CHMZHO LD($J,"BEN ERAN-TEXTM ESS1",CNTZ )="NO OHI  FILE NAME/ ADDRESS ON  FS3BIG=CR 1276BENENO NA.TXT",CN TZ=CNTZ+1
  249    S ^CHMZHO LD($J,"BEN ERAN-TEXTM ESS1",CNTZ )="NO OHI  FILE INFO  ON FS3BIG= CR1276BENE NOINFO.TXT ",CNTZ=CNT Z+1
  250    S ^CHMZHO LD($J,"BEN ERAN-TEXTM ESS1",CNTZ )="YOU MUS T IMMEDIAT ELY CHANGE  FILE NAME  ON FS3BIG    ",CNTZ= CNTZ+1
  251    S ^CHMZHO LD($J,"BEN ERAN-TEXTM ESS1",CNTZ )="******* ********** ********** ********** ********** ***",CNTZ= CNTZ+1
  252    S ^CHMZHO LD($J,"BEN ERAN-TEXTM ESS1",CNTZ )=""
  253    S XMTEXT= "^CHMZHOLD ($J,""BENE RAN-TEXTME SS1"","
  254    S XMDUZ=. 5
  255    ;S NAMDUZ =$P(^VA(20 0,DUZ,0)," ^",1)
  256    ;S LAST=$ P(NAMDUZ," ,",1)
  257    ;S FIRST= $P(NAMDUZ, ",",2)
  258    ;S NAME=L AST_", "_F IRST
  259    ;S NAMEOU T= PII            "
  260    ;S XMY(NA MEOUT)=""
  261    S XMY(DUZ )=""
  262    S XMSUB=" BENE NAME  AND ADDRES S OHI RAND OM SELECTE D" D ^XMD  ;
  263    K ^CHMZHO LD("BENE-N A-OHI-RAN- LABELS")
  264    K ^CHMZHO LD("ACCEPT -TOTAL-REC ORDS-CR127 6YES")
  265    K ^CHMZHO LD("ACCEPT -TOTAL-REC ORDS-CR127 6NO")
  266    Q
  267    ; NEXT CO DE NOT USE D,  REPLAC ED BY ROUT INES ZALC1 276Y AND Z ALC1276N
  268    ; 
  269    ; 
  270    ; 
  271    S GETTOT= ^CHMZHOLD( "ACCEPT-TO TAL-RECORD S-TRC")
  272    F X=1:1:2 501 S SAVS EQ(X)=$R(G ETTOT)+1 S  USENO=SAV SEQ(X) D
  273    .Q:'$D(CH MZHOLD("AC CEPT-TRC", USENO))
  274    .S DFNBFN =^CHMZHOLD ("ACCEPT-T RC",USENO)
  275    .S DFN=$P (DFNBFN,"^ ",1)
  276    .S BFN=$P (DFNBFN,"^ ",2)
  277    .;GET DFN ,BFN NAME  AND ADDRES S HERE
  278    .S NAMLAB =^AHCHVA(D FN,100,BFN ,0)
  279    .S ADDRLA B=^AHCHVA( DFN,100,BF N,1)
  280    .S STATE= $P(ADDRLAB ,U,4)
  281    .I STATE= "" Q
  282    .G GETBFN :'$D(^DIC( 5,STATE,0) )
  283    .S:STATE  STATE=$P(^ DIC(5,STAT E,0),U,2)
  284    .S (ZIP,Z IPZ)=""
  285    .S ZIPZ=$ P(ADDRLAB, U,5)
  286    .I $L(ZIP Z)>5 S ZIP 1=$E(ZIPZ, 1,5) S ZIP 2=$E(ZIPZ, 6,9) S ZIP Z=ZIP1_"-" _ZIP2
  287    .S T=$C(9 )
  288    .S ADDR1= $P(NAMLAB, U,1)
  289    .S ADDR2= $P(ADDRLAB ,U,1)
  290    .S ADDR3= $P(ADDRLAB ,U,2)
  291    .S ADDR4= $P(ADDRLAB ,U,12)
  292    .S ADDR5= $P(ADDRLAB ,U,3)_", " _STATE_" " _ZIPZ
  293    .I ADDR4' ="" S TMP= ADDR1_T_AD DR2_T_ADDR 3_T_ADDR4_ T_ADDR5
  294    .I ADDR4= "" S ADDR4 =ADDR5 S T MP=ADDR1_T _ADDR2_T_A DDR3_T_ADD R4
  295    .I ADDR3= "" S ADDR3 =ADDR5 S T MP=ADDR1_T _ADDR2_T_A DDR3
  296    .I ADDR2= "" S ADDR2 =ADDR5 S T MP=ADDR1_T _ADDR2
  297    .S TMP=TM P_SEX_T_AG E65_T_OHIS W_T_MEDSW_ T_APPDATE_ T_TELENO
  298    .;U FIO W  !,TMP
  299    .S CNT=CN T+1
  300    .;K ^CHMZ HOLD("ACCE PT-TRC",US ENO)
  301    .S GETTOT =GETTOT-1
  302    .Q
  303    C FIO
  304    ;
  305    Q
  306   CHKPHRM(CD FN,CBFN,CS TRDAT) ;CH ECKS BENE  FOR ONLY P HARMACY CL AIMS
  307    N PHMONLY ,CPDIDT
  308    S PHMONLY =1  ;BENE  ONLY PHARM ACY CLAIMS    0 = HAS  OTHER CLA IMS
  309    I $D(^CHM PAY("D",CD FN)) D
  310    .S CLMPTR =0 F  S CL MPTR=$O(^C HMPAY("D", CDFN,CLMPT R)) Q:'CLM PTR  D
  311    ..Q:'$D(^ CHMPAY(CLM PTR))
  312    ..Q:'$D(^ CHMPAY(CLM PTR,0))
  313    ..S CCLMC DT=$P($P(^ CHMPAY(CLM PTR,0),"^" ,10),".",1 )   ;GET C LAIM COMPL ETED DATE
  314    ..I CSTRD AT<=CCLMCD T D
  315    ...I $P(^ CHMPAY(CLM PTR,0),"^" ,7)'=3 D     ;CHECK F OR PHARMAC Y CLAIMS
  316    ....S PHM ONLY=0
  317    Q PHMONLY
  318