IBCNERTC.m

IBCNERTC ;AITC/HN - Covered by Health Insurance ;03-MAR-2017

 ;;2.0;INTEGRATED BILLING;**593**;21-MAR-94;Build 31

 ;;Per VA Directive 6402, this routine should not be modified.

 ;

 ;**Program Description**

 ;  This program will loop through the ACHI Index of the Patient (2) file to update the 

 ;  Covered by Health Insurance (2.3192) field based on current active policies.

 ;

 ;  This option is designed to run through TaskMan after midnight.  It shouldn't take long since there

 ;  should not be many entries in the ACHI index per day.

 ;

 ;  UPATF should be used with care since it will process the entire Patient File

 ;

 Q

 ;

EN(IBDT) ;From Taskman nightly job.  Call from label TASK.

 N DFN

 S DFN=""

 F  S DFN=$O(^DPT("ACHI",IBDT,DFN)) Q:'DFN  D INS(DFN,IBDT)

 Q

 ;

INS(DFN,IBDT) ;Check insurance

 N DA,DIE,IBCOV,IBIND,IBINS,IBNCOV,DR,IBINSD,IENS,EFFDT,IBIENS,DEFIND,IBIEN,IBSYM

 S (IBCOV,IBNCOV)=$$GET1^DIQ(2,DFN_",","COVERED BY HEALTH INSURANCE?","I")

 D ALL^IBCNS1(DFN,"IBINS",2,IBDT) S IBINSD=+$G(IBINS(0))

 ;

 ; -- initial value ="" or Unknown

 I $TR(IBCOV,"U","")']"" S IBNCOV=$S('$O(^DPT(DFN,.312,0)):"U",IBINSD:"Y",1:"N")

 ; -- initial value = YES or NO (treat the same)

 I "YN"[IBCOV S IBNCOV=$S('$O(^DPT(DFN,.312,0)):"N",IBINSD:"Y",1:"N")

 ;

 I IBCOV'=IBNCOV S DIE="^DPT(",DR=".3192///"_IBNCOV,DA=DFN D ^DIE

 ;

 ; Create Buffer entry for those whose Effective Date = IBDT

 ;

 S DA=0 F  S DA=$O(IBINS(DA)) Q:'DA  D

 . S IBIEN=+IBINS(DA,0)

 . S IBIENS=DA_","_DFN_","

 . S EFFDT=$$GET1^DIQ(2.312,IBIENS,8,"I")

 . I EFFDT'=IBDT Q

 . ; Add check to see if already in buffer

 . S DEFIND=$$BFEXIST(DFN,IBIEN) Q:DEFIND=1

 . S IBSYM=$P($$INSERROR^IBCNEUT3("I",IBIEN),"^",1)

 . D PT^IBCNEBF(DFN,DA,IBSYM,,1)

 Q

 ;

UPATF ;Update the entire Patient File

 ; This should be tasked for late evening since it will take awhile to run.

 N DFN,IENS

 S DFN=0

 F  S DFN=$O(^DPT(DFN)) Q:'DFN  D

 . D INS(DFN,DT)

 Q

 ;

BFEXIST(DFN,INSNAME) ; Function returns 1 if an Entered Ins Buffer File 

 ; entry exists with the same DFN and INSNAME, otherwise it returns a 0

 ;

 ; DFN - Patient DFN

 ; INSNAME - Insurance Company Name File 36 - Field .01

 ;

 NEW EXIST,IEN,EDATE

 S EXIST=0

 S INSNAME=$P($G(^DIC(36,IBIEN,0)),U) ;$$TRIM^XLFSTR(INSNAME)  ; trimmed

 I ('DFN)!(INSNAME="") G BFEXIT

 ;

 S IEN=0

 F  S IEN=$O(^IBA(355.33,"C",DFN,IEN)) Q:'IEN!EXIST  D

 .  ; Quit if status is NOT 'Entered'

 .  I $$GET1^DIQ(355.33,IEN_",","STATUS","I")'="E" Q

 .  ; Quit if Ins Buffer Ins Co Name (trimmed) is NOT EQUAL to 

 .  ;  the Ins Co Name parameter (trimmed)

 .  I $$TRIM^XLFSTR($$GET1^DIQ(355.33,IEN_",","INSURANCE COMPANY NAME"))'=INSNAME Q

 .  ; Quit if Date Enterd Matches

 .  S EDATE=$P($$GET1^DIQ(355.33,IEN_",","DATE ENTERED","I"),".")

 .  I IBDT'=EDATE Q

 .  ; Match found

 .  S EXIST=1

 .  Q

BFEXIT ;

 Q EXIST

 ;

XREF ;Build the "ACHI" cross reference

 N CNT,DA,DFN,FILE,DIK,X,Y

 S DFN=0

 F  S DFN=$O(^DPT(DFN)) Q:'DFN  D

 . I $$GET1^DIQ(2,DFN_","_"DATE OF DEATH") Q  ;Patient Deceased

 . S DA(1)=DFN

 . S DIK="^DPT("_DA(1)_",.312,"

 . S DIK(1)="3^ACHI"

 . D ENALL^DIK

 . S DIK(1)="8^ACHI"

 . D ENALL^DIK

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IBCNERTC   3196     printed  Mar 13, 2025@21:20:07                                                                                                                                                                                                    Page 2

IBCNERTC  ;AITC/HN - Covered by Health Insurance ;03-MAR-2017

 +1       ;;2.0;INTEGRATED BILLING;**593**;21-MAR-94;Build 31

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;

 +4       ;**Program Description**

 +5       ;  This program will loop through the ACHI Index of the Patient (2) file to update the 

 +6       ;  Covered by Health Insurance (2.3192) field based on current active policies.

 +7       ;

 +8       ;  This option is designed to run through TaskMan after midnight.  It shouldn't take long since there

 +9       ;  should not be many entries in the ACHI index per day.

 +10      ;

 +11      ;  UPATF should be used with care since it will process the entire Patient File

 +12      ;

 +13       QUIT 

 +14      ;

EN(IBDT)  ;From Taskman nightly job.  Call from label TASK.

 +1        NEW DFN

 +2        SET DFN=""

 +3        FOR 

               SET DFN=$ORDER(^DPT("ACHI",IBDT,DFN))

               if 'DFN

                   QUIT 

               DO INS(DFN,IBDT)

 +4        QUIT 

 +5       ;

INS(DFN,IBDT) ;Check insurance

 +1        NEW DA,DIE,IBCOV,IBIND,IBINS,IBNCOV,DR,IBINSD,IENS,EFFDT,IBIENS,DEFIND,IBIEN,IBSYM

 +2        SET (IBCOV,IBNCOV)=$$GET1^DIQ(2,DFN_",","COVERED BY HEALTH INSURANCE?","I")

 +3        DO ALL^IBCNS1(DFN,"IBINS",2,IBDT)

           SET IBINSD=+$GET(IBINS(0))

 +4       ;

 +5       ; -- initial value ="" or Unknown

 +6        IF $TRANSLATE(IBCOV,"U","")']""

               SET IBNCOV=$SELECT('$ORDER(^DPT(DFN,.312,0)):"U",IBINSD:"Y",1:"N")

 +7       ; -- initial value = YES or NO (treat the same)

 +8        IF "YN"[IBCOV

               SET IBNCOV=$SELECT('$ORDER(^DPT(DFN,.312,0)):"N",IBINSD:"Y",1:"N")

 +9       ;

 +10       IF IBCOV'=IBNCOV

               SET DIE="^DPT("

               SET DR=".3192///"_IBNCOV

               SET DA=DFN

               DO ^DIE

 +11      ;

 +12      ; Create Buffer entry for those whose Effective Date = IBDT

 +13      ;

 +14       SET DA=0

           FOR 

               SET DA=$ORDER(IBINS(DA))

               if 'DA

                   QUIT 

               Begin DoDot:1

 +15               SET IBIEN=+IBINS(DA,0)

 +16               SET IBIENS=DA_","_DFN_","

 +17               SET EFFDT=$$GET1^DIQ(2.312,IBIENS,8,"I")

 +18               IF EFFDT'=IBDT

                       QUIT 

 +19      ; Add check to see if already in buffer

 +20               SET DEFIND=$$BFEXIST(DFN,IBIEN)

                   if DEFIND=1

                       QUIT 

 +21               SET IBSYM=$PIECE($$INSERROR^IBCNEUT3("I",IBIEN),"^",1)

 +22               DO PT^IBCNEBF(DFN,DA,IBSYM,,1)

               End DoDot:1

 +23       QUIT 

 +24      ;

UPATF     ;Update the entire Patient File

 +1       ; This should be tasked for late evening since it will take awhile to run.

 +2        NEW DFN,IENS

 +3        SET DFN=0

 +4        FOR 

               SET DFN=$ORDER(^DPT(DFN))

               if 'DFN

                   QUIT 

               Begin DoDot:1

 +5                DO INS(DFN,DT)

               End DoDot:1

 +6        QUIT 

 +7       ;

BFEXIST(DFN,INSNAME) ; Function returns 1 if an Entered Ins Buffer File 

 +1       ; entry exists with the same DFN and INSNAME, otherwise it returns a 0

 +2       ;

 +3       ; DFN - Patient DFN

 +4       ; INSNAME - Insurance Company Name File 36 - Field .01

 +5       ;

 +6        NEW EXIST,IEN,EDATE

 +7        SET EXIST=0

 +8       ;$$TRIM^XLFSTR(INSNAME)  ; trimmed

           SET INSNAME=$PIECE($GET(^DIC(36,IBIEN,0)),U)

 +9        IF ('DFN)!(INSNAME="")

               GOTO BFEXIT

 +10      ;

 +11       SET IEN=0

 +12       FOR 

               SET IEN=$ORDER(^IBA(355.33,"C",DFN,IEN))

               if 'IEN!EXIST

                   QUIT 

               Begin DoDot:1

 +13      ; Quit if status is NOT 'Entered'

 +14               IF $$GET1^DIQ(355.33,IEN_",","STATUS","I")'="E"

                       QUIT 

 +15      ; Quit if Ins Buffer Ins Co Name (trimmed) is NOT EQUAL to 

 +16      ;  the Ins Co Name parameter (trimmed)

 +17               IF $$TRIM^XLFSTR($$GET1^DIQ(355.33,IEN_",","INSURANCE COMPANY NAME"))'=INSNAME

                       QUIT 

 +18      ; Quit if Date Enterd Matches

 +19               SET EDATE=$PIECE($$GET1^DIQ(355.33,IEN_",","DATE ENTERED","I"),".")

 +20               IF IBDT'=EDATE

                       QUIT 

 +21      ; Match found

 +22               SET EXIST=1

 +23               QUIT 

               End DoDot:1

BFEXIT    ;

 +1        QUIT EXIST

 +2       ;

XREF      ;Build the "ACHI" cross reference

 +1        NEW CNT,DA,DFN,FILE,DIK,X,Y

 +2        SET DFN=0

 +3        FOR 

               SET DFN=$ORDER(^DPT(DFN))

               if 'DFN

                   QUIT 

               Begin DoDot:1

 +4       ;Patient Deceased

                   IF $$GET1^DIQ(2,DFN_","_"DATE OF DEATH")

                       QUIT 

 +5                SET DA(1)=DFN

 +6                SET DIK="^DPT("_DA(1)_",.312,"

 +7                SET DIK(1)="3^ACHI"

 +8                DO ENALL^DIK

 +9                SET DIK(1)="8^ACHI"

 +10               DO ENALL^DIK

               End DoDot:1

 +11       QUIT