8. EPMO Open Source Coordination Office Redaction File Detail Report

Produced by Araxis Merge on 9/28/2018 12:31:36 PM Central Daylight 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.

8.1 Files compared

# Location File Last Modified
1 MCCF_EDI_TAS_IB_2.0_621.zip TAS+eIns+US3511+SDD+v1.0.docx Wed Sep 26 22:33:51 2018 UTC
2 MCCF_EDI_TAS_IB_2.0_621.zip TAS+eIns+US3511+SDD+v1.0.docx Wed Sep 26 23:18:10 2018 UTC

8.2 Comparison summary

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

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

8.4 Active regular expressions

No regular expressions were active.

8.5 Comparison detail

  1   MCCF EDI T AS EINSURA NCE US3511
  2   System Des ign Docume nt
  3   IB*2.0*602
  4  
  5  
  6  
  7  
  8   Department  of Vetera ns Affairs
  9   December 2 017
  10   Version 1. 0
  11   User Story  Number: U S3511
  12   User Story  Name: Ele ctronic In surance Co verage Dis covery: Da ta Extract
  13  
  14   Epic Taxon omy
  15     eBiz Com pliance         Port         Upd ate         Increase  No Touch         TAS  Apps
  16   Story:
  17   As a...
  18   I want to. ..
  19   So that...
  20   Consumer o f Electron ic Insuran ce Coverag e Discover y (EICD) f unctionali ty
  21   Extract pa tient demo graphics f rom VistA,  based on  scheduled  appointmen ts, for pa tients who  have no a ctive insu rance info rmation sa ved in Vis tA.
  22   The EICD f unctionali ty can bui ld an HL7  message to  be sent t o Financia l Services  Center (F SC) where  it will be  converted  to an X12  270 EICD  Request an d sent to  TransUnion  (TU).
  23  
  24   Clean up n eeded
  25   :: Routine : IBCNEDE6
  26   Remove tag  INAC
  27   Remove tag  INACSET
  28   Remove tag  BLANKTQ
  29  
  30   :: Routine : IBCNEDE5
  31   Remove tag  SIDCHK2 ( note: this  tag is ca lled from  IBCNEDE4;  we’ll be d oing major  renovatio ns in that  extract b elow; part  of those  changes in volve tag  removal in cluding “P OP” which  contains t he SIDCHK2  call)
  32  
  33  
  34   Call the E ICD Extrac t
  35   :: Routine : IBCNEDE  - main dri ver of eIV  Nightly P rocess
  36   Add the th ree lines  shown belo w, directl y after li ne 52 “D E N^IBCNEDE2  ; Pre Reg  Extract”
  37    ; Check t o see if b ackground  process ha s been sto pped, if s o quit.
  38   I $G(ZTSTO P) G ENX
  39   D EN^IBCNE DE4 ; No I nsurance E xtract (EI CD)
  40  
  41  
  42   EICD Extra ct
  43   :: Routine : IBCNEDE7
  44   In Tag: SE TTINGS
  45   Update fun ction to a ccept EXTN UM=4   ; t his is for  the insur ance disco very aka n o insuranc e extract
  46  
  47   With regar ds to chec king for m issing dat a like lin es 49 thru  51 (see b elow) for  EXTNUM=4,  if  XDAYS  =”” set th e variable  to zero w hen passin g it back  out of thi s routine.   Make sur e STALEDYS  is popula ted for EX TNUM=4 oth erwise set  EACTIVE t o 0 to sto p the extr act from r unning.
  48    I EXTNUM= 2,(XDAYS=" ") S EACTI VE=0 ; mis sing requi red data I  EXTNUM=3  D . I XDAY S=""!(STAL EDYS="") S  EACTIVE=0  ; missing  required  data
  49  
  50   Make sure  you pull ( and return ) selectio n criteria  #1, selec tion crite ria #2 and  selection  criteria  #3; Check  STALEDYS a s it may a lready be  pulling se lection cr iteria #2.
  51  
  52   :: Routine : IBCNEDE4  (major re write) 
  53   Add the pa tch number  to the se cond line  of the rou tine.  Don ’t make th e mistake  of restart ing over w ith patch  numbers ju st because  we are re using the  routine.
  54  
  55   Update the  directive  on the th ird line 
  56  
  57   Fix “Note”  and “Prog ram descri ption” – l ines 5 & 1 0
  58   (most comm ents for o ther patch es can be  removed, e .g. “IB*2* 416”)
  59   Make refer ence to “E ICD”
  60   Explain th at we are  rewriting  the entire  logic for  determini ng insuran ce for tho se who don ’t have ac tive polic ies with p atch xyz
  61  
  62   When all i s done mak e sure var iables bei ng new’d o n line 19- 22 are acc urate and  there are  no leftove rs
  63  
  64   Keep lines  24 - 34 ( Set INCNCN T=0   thru  getting e xtract par ameters)
  65    S IBCNCNT =0 ; Initi alize coun t for peri odic TaskM an check S  IBCNETOT= 0 ; ; Get  Extract pa rameters S  EACTIVE=$ $SETTINGS^ IBCNEDE7(4 ) I 'EACTI VE Q                     ; quit  if not act ive S XDAY S=$P(EACTI VE,U,2) S  YDAYS=$P(E ACTIVE,U,3 ) S MAXCNT =$P(EACTIV E,U,4) S:M AXCNT="" M AXCNT=9999 999999
  66  
  67   Pull start  and end d ate ranges  from site  parameter s within I BCENDE7
  68  
  69   Using the  EICD payer  from the  site param eters conf irm using  file (#365 .12) that  the payer  is both na tionally a ctive and  for the II V applicat ion is loc ally activ e.  If eit her field  is inactiv e quit and  stop proc essing for  this extr act. No ne ed to prov ide any me ssage – qu iet quit.
  70  
  71   Change lin e 37 – Cal culate the  start and  end date  range from  the site  parameters  that you’ ve already  pulled
  72    S IBBDT=$ $FMADD^XLF DT(DT,-XDA YS),IBEDT= DT
  73  
  74   Remove lin es:
  75   Lines that  control t he main ro utine:  li nes 41 – 6 4
  76  
  77   Remove tag s:
  78   INP
  79   OUTP
  80   REST
  81   PROCESS
  82   POP
  83   POPSET
  84  
  85   You should  be left w ith nothin g past lin e 37 which  you corre cted above .
  86  
  87   Now … usin g IBCNEDE2  as a temp late (util ize the co py pasted  at the end  of this S DD doc as  a guide si nce it cou ld switch  with other  changes d uring this  build) 
  88  
  89   The rest o f this cod e is to be  placed in to IBCNEDE 4 after yo ur last li ne which i s line 37  as describ ed above.
  90  
  91   Gather cli nics
  92   Copy lines  34 – 49 f rom IBCNED E2 … chang e referenc es to IBCN EDE2 to IB CNEDE4 & m ake the ca ll to CLIN ICEX^IBCNE DE2
  93    From: “K  ^TMP($J,"S DAMA301"), ^TMP("IBCN EDE2",$J)  ; Clean TM P globals”  ;. 
  94  
  95  
  96   Through: “ S NUM=$$SD API^SDAMA3 01(.IBSDA)  I NUM<1 D :NUM<0 ERR MSG G ENQ”
  97  
  98   Loop throu gh clinics , identify  patients  and popula te IIV Tra nsmission  Queue file  #365.1
  99   Copy lines  52 – 83 f rom IBCNED E2 ... mak e call to  ELG^IBCNED E2 & drop  commented  out line f or decease d patients  we are no t excludin g them  (y ou can’t r eference p atch #549)
  100   Make use o f the star t and end  dates that  you deriv ed from th e data you  pulled fr om the sit e paramete rs (see ab ove) when  looping th rough the  appointmen t dates
  101   Set  FRESH DT= extrac t date - s election c riteria #2  (#350.900 2,.04)
  102   CAREFUL –  A patient  can have m ore than o ne appoint ment in th e date ran ge you don ’t want to  reevaluat e the same  patient t wice and y ou don’t w ant more t han one EI CD for the  patient.
  103   In the mid dle of thi s logic yo u find the  DFN of th e patient  … determin e if we ca n skip thi s patient  based on   the “Date  Last EICD  Run” (#2.x xxx,.01) a nd the sel ection cri teria #2 ( #350.9002, .04) that  you pulled  from the  site param eters (see  above).   If the Dat e Last EIC D Run grea ter than F RESHDT (se e above) s kip the pa tient
  104   Once the p atient is  identified  … determi ne if they  have acti ve insuran ce as defi ned in US3 511 user s tory
  105   Loop throu gh policie s
  106   Use the IN SURANCE TY PE (#2.312 ,.01) fiel d to deter mine the i nsurance c ompany nam e
  107   Use the EF FECTIVE DA TE OF POLI CY (#2.312 ,8) field
  108   Use the IN SURANCE EX PIRATION D ATE (#2.31 2,3) field
  109   Use the GR OUP PLAN ( #2.312, .1 8) -> TYPE  OF PLAN ( #355.3,.09 )  get ext ernal valu e to check
  110   If the ACT INS has no  policies  then conti nue proces sing patie nt
  111   If any of  the active  policies  does NOT m eet the cr iteria of  “don’t con sider them  active” t hen skip t he patient
  112  
  113   Determine  if there i s already  an entry i n the TQ w aiting to  go out for  this EICD  payer
  114   Make a cal l to ADDTQ ^IBCNEUT5   pass in D FN, payer  ien of the  EICD paye r, Today’s  date as t he service  date, and  FRESHDAY  as selecti on critier ia #3 from  the site  parameters  that you  pulled fro m IBCNEDE7 .  See bel ow for an  example:  
  115                                  ;  Quit befo re filing  if outstan ding entri es in TQ                                I ' $$ADDTQ^IB CNEUT5(DFN ,PIEN,SRVI CEDT,FRESH DAY) Q
  116   For every  patient th at we cont inue proce ssing with  …
  117   To match t he same lo ok, feel,  and flow f rom the ot her eIV ex tracts : c all a tag  “SET” to d efine your  variables  and call  SETTQ^IBCN EDE7  
  118   (see IBCNE DE1 and IB CNEDE2 for  examples)
  119   DFN = pati ent’s ien
  120   QURYFLAG=” I”  ; the  letter “i"  in Caps
  121   FRESHDT= s ee calcula tion above
  122   ; The hard  coded '1'  in the 3r d piece of  DATA1 set s the Tran smission s tatus of f ile 365.1  to "Ready  to Transmi t"
  123   DATA1=DFN^ payer ien  ^1^^^FRESH DT^
  124   ; The hard coded '4'  in the 1st  piece of  DATA2 is t he value t o tell the  file 365. 1 that it  is the No  Insurance  (EICD) ext ract.
  125   DATA2=4^QU RYFLAG^DT
  126   ; source o f informat ion pulled  from file  #355.12
  127   DATA5= ien  for the s ource of i nfo entry  “CONTRACT  SERVICES”
  128  
  129   Finished! 
  130   Test!
  131  
  132  
  133   IMPORTANT  … USE THIS  COPY OF I BCNEDE2 as  a guide s ince the r outine on  the develo pment or C IT account  could be  different  by the tim e one is m aking thes e coding c hanges.
  134  
  135   *** The su per small  font is on  purpose s o that not hing is wr apped as t he program mer will b e literall y copying  lines from  this sect ion of the  document.  *** 
  136  
  137   For old ey es, please  use the v iew tab in  word and  zoom … don ’t change  the font.
  138  
  139   IBCNEDE2 ; DAOU/DAC -  eIV PRE R EG EXTRACT  (APPTS) ; 23-SEP-201 5 ;;2.0;IN TEGRATED B ILLING;**1 84,271,249 ,345,416,4 38,506,549 ,593**;21- MAR-94;Bui ld 31 ;;Pe r VA Direc tive 6402,  this rout ine should  not be mo dified. ;  ;**Program  Descripti on** ; Thi s program  finds vete rans who a re schedul ed to be s een within  a ; speci fied date  range. ; P eriodicall y check fo r stop req uest for b ackground  task ; Q    ; can't b e called d irectly ;E N ; Loop t hrough des ignated cr oss-refere nces for u pdates ; P re reg ext ract (Appo intment ex tract) ; I B*2.0*593  - Added EX CLTOC,EXCL TOP now in itialized  at top. Re moved YY.  ; IB*2.0*5 49 - Added  YY,ZZ, Re -Arranged  in alphabe tical orde r N ACTINS ,APTDT,CLN C,CNT,DATA 1,DATA2,DF N,DISYS,EL G,ENDDT,EX CLTOC,EXCL TOP,FOUND1 ,FOUND2,FR ESHDAY N F RESHDT,GIE N,IBCNETOT ,IBDDI,IBI NDT,IBINS, IBSDA,IBSD ATA,IBOUTP ,INREC,INS ,INSIEN,IN SNAME N MA XCNT,MCARE FLG,NUM,OK ,PATID,PAY ER,PAYERID ,PAYERSTR, PIEN N SET STR,SID,SI DACT,SIDAR RAY,SIDCNT ,SIDDATA,S LCCRIT1,SR VICEDT,SUP PBUFF,SYMB OL N TODAY SDT,TQIEN, QURYFLAG,V AIN,VDATE, YY,ZZ ; S  SETSTR=$$S ETTINGS^IB CNEDE7(2)  ; Get sett ing for pr e reg. ext ract  I 'S ETSTR Q                            ; Quit i f extract  is not act ive S SLCC RIT1=$P(SE TSTR,U,2)  ; Selectio n Criteria  #1 S MAXC NT=$P(SETS TR,U,4) ;  Max # of T Q entries  to create  S:MAXCNT=" " MAXCNT=9 999999999  S SUPPBUFF =$P(SETSTR ,U,5) ; Su ppress Buf fer Flag S  FRESHDAY= $P($G(^IBE (350.9,1,5 1)),U,1) ;  Freshness  days span  S CNT=0 ;  Init. TQ  entry coun ter S ENDD T=$$FMADD^ XLFDT(DT,S LCCRIT1) ;  End of ap pt. date s election r ange S IBC NETOT=0 ;  Initialize  count for  periodic  TaskMan ch eck S EXCL TOC=$$GETE LST(355.2)  ; Initial ize exclud ed TYPEs O F COVERAGE  IB*2.0*59 3 S EXCLTO P=$$GETELS T(355.1) ;  Initializ e excluded  TYPEs OF  PLAN IB*2. 0*593 K ^T MP($J,"SDA MA301"),^T MP("IBCNED E2",$J) ;  Clean TMP  globals ;  S CLNC=0 ;  Init. cli nic ; Loop  through c linics  F   S CLNC=$O (^SC(CLNC) ) Q:'CLNC! (CNT'<MAXC NT) D  Q:$ G(ZTSTOP)  . ; . D CL INICEX Q:' OK     ; C heck for c linic excl usion . ;  . S ^TMP(" IBCNEDE2", $J,CLNC)=" " ; ; Set  up variabl es for sch eduling ca ll and cal l S IBSDA( "FLDS")=8  S IBSDA(1) =DT_";"_EN DDT S IBSD A(2)="^TMP (""IBCNEDE 2"",$J," S  IBSDA(3)= "R" S NUM= $$SDAPI^SD AMA301(.IB SDA) I NUM <1 D:NUM<0  ERRMSG G  ENQ ; ; S  CLNC=0 ; I nit. clini c ; Loop t hrough cli nics retur ned F  S C LNC=$O(^TM P($J,"SDAM A301",CLNC )) Q:'CLNC   D  Q:$G( ZTSTOP)!(C NT'<MAXCNT ) . ; . ;  Loop throu gh patient s returned  . S DFN=0  F  S DFN= $O(^TMP($J ,"SDAMA301 ",CLNC,DFN )) Q:'DFN! (CNT'<MAXC NT) D  Q:$ G(ZTSTOP)  .. ; .. S  APTDT=DT            ;  Check for  appointme nt date ..  S MCAREFL G=0 .. ; . . ; Loop t hrough dat es in rang e at clini c .. F  S  APTDT=$O(^ TMP($J,"SD AMA301",CL NC,DFN,APT DT)) Q:('A PTDT)!((AP TDT\1)>END DT)!(CNT'< MAXCNT) D   Q:$G(ZTST OP) ... ;  ... S SRVI CEDT=APTDT \1 ;Set se rvice date  equal to  appointmen t date ...  S FRESHDT =$$FMADD^X LFDT(SRVIC EDT,-FRESH DAY) ... ;  ... ; Upd ate count  for period ic check . .. S IBCNE TOT=IBCNET OT+1 ... ;  Check for  request t o stop bac kground jo b, periodi cally ...  I $D(ZTQUE UED),IBCNE TOT#100=0, $$S^%ZTLOA D() S ZTST OP=1 Q ...  ; ... S I BSDATA=$G( ^TMP($J,"S DAMA301",C LNC,DFN,AP TDT)) ...  S ELG=$P(I BSDATA,U,8 ) ... S EL G=$S(ELG'= "":ELG,1:$ P($G(^DPT( DFN,.36)), U,1)) ...  I $P($G(^D PT(DFN,0)) ,U,21) Q          ; E xclude if  test patie nt ... ; I B*2.0*549  removed th e followin g line ...  ;I $P($G( ^DPT(DFN,. 35)),"^",1 )'="" Q ;  Exclude if  patient i s deceased  ... ; ...  D ELG Q:' OK     ; C heck for e ligibility  exclusion  ... ; ...  K ACTINS  ... D ALL^ IBCNS1(DFN ,"ACTINS", 2) ... ; . .. I '$D(A CTINS(0))  Q  ; Patie nt has no  active ins  ... ; ...  S INREC=0  ; Record  IEN ... F   S INREC=$ O(ACTINS(I NREC)) Q:( 'INREC)!(C NT'<MAXCNT ) D ... .  S INSIEN=$ P($G(ACTIN S(INREC,0) ),U,1) ; I nsurance i en ... . S  INSNAME=$ P($G(^DIC( 36,INSIEN, 0)),U) ...  . ; ... .  ; IB*2.0* 549 Added  next 3 lin es to excl ude certai n Type of  Coverages  ... . ; IB *2.0*593 M oved exclu sion list  initializa tion to to p executio n level. . .. . S ZZ= $$GET1^DIQ (36,INSIEN _",",.13," I") ; Type  of Covera ge ... . ; S YY=$$GET ELST(355.2 ) ; Type o f Coverage s to exclu de ... . ; Q:YY[("^"_ ZZ_"^") ;  Excluded T ype of Cov erage ...  . Q:EXCLTO C[("^"_ZZ_ "^") ; Exc luded Type  of Covera ge ... . ;  ... . ; E xclude pol icies that  have been  verified  within "fr eshness da ys" ... .  S VDATE=$P ($G(ACTINS (INREC,1)) ,U,3) ...  . I VDATE' ="",SRVICE DT'>$$FMAD D^XLFDT(VD ATE,FRESHD AY) Q ...  . ; Allow  only one M EDICARE tr ansmission  per patie nt ... . I  INSNAME[" MEDICARE", MCAREFLG Q  ... . ; E xclude pha rmacy poli cies IB*2. 0*549 - Co mmented ou t followin g line ...  . ;I $$GE T1^DIQ(36, INSIEN_"," ,.13)="PRE SCRIPTION  ONLY" Q .. . . S GIEN =+$P($G(AC TINS(INREC ,0)),U,18)  ... . ; . .. . ; IB* 2.0*549 Ad ded next 3  lines to  exclude ce rtain Type  of Plans  ... . ; IB *2.0*593/T AZ Moved e xclusion l ist initia lization t o top exec ution leve l. ... . S  ZZ=$$GET1 ^DIQ(355.3 ,GIEN_",", .09,"I") ;  Type of P lan ... .  ;S YY=$$GE TELST(355. 1) ; Type  of Plans t o exclude  ... . ;Q:Y Y[("^"_ZZ_ "^") ; Exc luded Type  of Plan . .. . Q:EXC LTOP[("^"_ ZZ_"^") ;  Excluded T ype of Pla n ... . ;  ... . ;I G IEN,$$GET1 ^DIQ(355.3 ,GIEN_",", .09)="PRES CRIPTION"  Q ; IB*2.0 *549 - Rem oved line  ... . ; ch eck for in s. to excl ude (i.e.  Medicaid)  ... . I $$ EXCLUDE^IB CNEUT4(INS NAME) Q .. . . ; chec
  140   k insuranc e policy e xpiration  date ... .  I $$EXPIR ED($P($G(A CTINS(INRE C,0)),U,4) ) Q ... .  ; ... . ;  set patien t id field  IB*2*416  ... . S PA TID=$P($G( ACTINS(INR EC,5)),U,1 ) ; 5.01 f ield ... .  ; ... . S  PAYERSTR= $$INSERROR ^IBCNEUT3( "I",INSIEN ) ; Get pa yer info . .. . ; ...  . S SYMBO L=+PAYERST R ; error  symbol ...  . S PAYER ID=$P(PAYE RSTR,U,3)  ; (Nationa l ID) paye r id ... .  S PIEN=$P (PAYERSTR, U,2) ; Pay er ien ...  . ; ... .  ; If Paye r is Natio nally Inac tive creat e an Insur ance Buffe r record w /blank SYM BOL & quit . - IB*2.0 *506 ... .  I '$$PYRA CTV^IBCNED E7(PIEN) D   Q ... ..  S SYMBOL= "" ... ..  I 'SUPPBUF F,'$$BFEXI ST^IBCNEUT 5(DFN,INSN AME) D PT^ IBCNEBF(DF N,INREC,SY MBOL,"",1)  ... .. Q  ... . ; .. . . ; If e rror symbo l exists,  set record  in insura nce buffer  & quit .. . . I SYMB OL D  Q .. . . . I 'S UPPBUFF,'$ $BFEXIST^I BCNEUT5(DF N,INSNAME)  D PT^IBCN EBF(DFN,IN REC,SYMBOL ,"",1) ...  . ; ... .  ; Update  service da te and fre shness dat e based on  payers al lowed ...  . ; date r ange ... .  D UPDDTS^ IBCNEDE6(P IEN,.SRVIC EDT,.FRESH DT) ... .  ; ... . ;  Update ser vice dates  for inqui ry to be t ransmitted  ... . D T QUPDSV^IBC NEUT5(DFN, PIEN,SRVIC EDT) ... .  ; ... . ;  Quit befo re filing  if outstan ding entri es in TQ . .. . I '$$ ADDTQ^IBCN EUT5(DFN,P IEN,SRVICE DT,FRESHDA Y) Q ... .  ; ... . S  QURYFLAG= "V" ... .  K SIDARRAY  ... . S S IDDATA=$$S IDCHK^IBCN EDE5(PIEN, DFN,,.SIDA RRAY,FRESH DT) ... .  S SIDACT=$ P(SIDDATA, U),SIDCNT= $P(SIDDATA ,U,2) ...  . I SIDACT =3,'SUPPBU FF,'$$BFEX IST^IBCNEU T5(DFN,INS NAME) D PT ^IBCNEBF(D FN,INREC,1 8,"",1) Q  ... . I CN T+SIDCNT>M AXCNT S CN T=MAXCNT Q   ;exceeds  MAXCNT .. . . ; ...  . S SID=""  ... . F   S SID=$O(S IDARRAY(SI D)) Q:SID= ""  D:$P(S ID,"_")'=" " SET($P(S ID,"_"),$P (SID,"_",2 ),PATID) S :INSNAME[" MEDICARE"  MCAREFLG=1  ... . I S IDACT=4 D  ... . . D  SET("","", PATID) ...  . . S:INS NAME["MEDI CARE" MCAR EFLG=1 ...  . Q ... Q ENQ K ^TMP ($J,"SDAMA 301"),^TMP ("IBCNEDE2 ",$J) Q ;G ETELST(FIL E) ; Retur ns a '^' d elimited l ist of Typ e of Plans  or Type o f ; covera ges to be  excluded w ith leadin g and trai ling '^'s  ; IB*2.0*5 49 Added m ethod ; IB *2.0*593 A dded NO-FA ULT INSURA NCE. Refac tored. ; I nput: FILE  - 355.1 -  Return a  list of Ty pe of Plan s to be ex cluded ; 3 55.2 - Ret urn a list  of Type o f Coverage s to be ex cluded ; R eturns: '^ ' delimite d list of  Type of Pl ans or Typ e of Cover ages ; to  be exclude d ;N EXCLI ST,IEN,NM, XX ;S EXCL IST="",NM( "AUTOMOBIL E")="",NM( "MEDI-CAL" )="",NM("T ORT FEASOR ")="" ;S N M("WORKERS ' COMPENSA TION INSUR ANCE")="", NM("VA SPE CIAL CLASS ")="" ;S N M("MEDICAI D")="" ;S  XX="" ;F D  Q:XX="" ; . S XX=$O( NM(XX)) ;.  Q:XX="" ; . S IEN=""  ;. F D Q: IEN="" ;.  . S IEN=$O (^IBE(FILE ,"B",XX,IE N)) ;. . Q :IEN="" ;.  . S EXCLI ST=$S(EXCL IST="":IEN ,1:EXCLIST _"^"_IEN)  N EXCLIST, TYPE S EXC LIST="" F  TYPE="AUTO MOBILE","M EDICAID"," MEDI-CAL", "NO-FAULT  INSURANCE" ,"TORT FEA SOR","WORK ERS' COMPE NSATION IN SURANCE"," VA SPECIAL  CLASS" D  . N IEN S  IEN=$O(^IB E(FILE,"B" ,TYPE,""))  . Q:IEN=" " . S EXCL IST=$S(EXC LIST="":IE N,1:EXCLIS T_"^"_IEN)  Q "^"_EXC LIST_"^" ; CLINICEX ;  Clinic ex clusion S  OK=1 I $D( ^DG(43,1," DGPREC","B ",CLNC)) S  OK=0 Q ;E LG ; Eligi bility exc lusion I E LG="" S OK =0 Q I $D( ^DG(43,1," DGPREE","B ",ELG)) S  OK=0 Q S O K=1 Q ;INP  ; Inpatie nt status  D INP^VADP T I $G(VAI N(1))'=""  K VAIN S O K=0 Q K VA IN S OK=1  Q ;SET(SID ,INR,PATID ) ; Set da ta in TQ ;  ; The har d coded '1 ' in the 3 rd piece o f DATA1 se ts the Tra nsmission  ; status o f file 365 .1 to "Rea dy to Tran smit" S DA TA1=DFN_U_ PIEN_U_1_U _""_U_SID_ U_FRESHDT  ; SETTQ 1s t paramete r S $P(DAT A1,U,8)=PA TID     ;  IB*2*416 ;  ; The har dcoded '2'  in the 1s t piece of  DATA2 is  the value  to tell ;  the file 3 65.1 that  it is the  appointmen t extract.  S DATA2=2 _U_QURYFLA G_U_SRVICE DT_U_INR     ; SETTQ  2nd parame ter ; S TQ IEN=$$SETT Q^IBCNEDE7 (DATA1,DAT A2) ; Sets  in TQ I T QIEN'="" S  CNT=CNT+1  ; If file d incremen t count ;  Q ;ERRMSG  ; Send a m essage ind icating an  extract e rror has o ccurred N  MGRP,XMSUB ,MSG,IBX,I BM ; ; Set  to IB sit e paramete r MAILGROU P S MGRP=$ $MGRP^IBCN EUT5() ; S  XMSUB="eI V Problem:  Appointme nt Extract " S MSG(1) ="On "_$$F MTE^XLFDT( DT)_" the  Appointmen t Extract  for eIV en countered  one or mor e" S MSG(2 )="errors  while atte mpting to  get Appoin tment data  from the  scheduling " S MSG(3) ="package. " S MSG(4) ="" S MSG( 5)="Error( s) encount ered: " S  MSG(6)=""  S MSG(7)="  Error Cod e Error Me ssage" S M SG(8)=" -- -------- - ---------- --" S IBM= 8,IBX=0 F   S IBX=$O( ^TMP($J,"S DAMA301",I BX)) Q:IBX =""  S IBM =IBM+1,MSG (IBM)=" "_ $$LJ^XLFST R(IBX,13)_ $G(^TMP($J ,"SDAMA301 ",IBX)) S  IBM=IBM+1, MSG(IBM)=" " S IBM=IB M+1,MSG(IB M)="As a r esult of t his error  the extrac t was not  done. The  extract" S  IBM=IBM+1 ,MSG(IBM)= "will be a ttempted a gain the n ext night  automatica lly. If yo u" S IBM=I BM+1,MSG(I BM)="conti nue to rec eive error  messages  you should  contact y our IRM" S  IBM=IBM+1 ,MSG(IBM)= "and possi bly call t he Help De sk for ass istance."  ; D MSG^IB CNEUT5(MGR P,XMSUB,"M SG(") ; Q  ;EXPIRED(E XPDT) ; ch eck if ins urance pol icy has al ready expi red ; EXPD T - expira tion date  (2.312/3)  ; returns  1 if expir ation date  is in the  past, 0 o therwise N  X1,X2 S X 1=+$G(DT), X2=+$G(EXP DT) I X1,X 2 Q $S($$F MDIFF^XLFD T(DT,EXPDT ,1)>0:1,1: 0) Q 0
  141  
  142  
  143