IVMLINS.m

IVMLINS ;ALB/KCL,PHH - IVM INSURANCE UPLOAD ; 14-JAN-94

 ;;2.0;INCOME VERIFICATION MATCH;**14,94**; 21-OCT-94

 ;;Per VHA Directive 10-93-142, this routine should not be modified.

 ;

 ;

EN ; - main entry point for IVM INSURANCE UPLOAD

 D BLD

 ;

 ; - if no patients in ASEG x-ref goto EXIT

 I IVMCTR=0 G EXIT

 ;

 S IVMINSUP=1

 ;

 ; - call list manager

 D EN^VALM("IVM INSURANCE UPLOAD")

 ;

 K IVMINSUP

 Q

 ;

 ;

BLD ; - build an array of patients with uploadable insurance data

 K ^TMP("IVMIUPL",$J)

 W !,"Building patient list for display..."

 ;

 ; - change (HLFS) if HL7 segment sep ever changes!

 S IVMCTR=0,HLFS="^"

 ;

 ; - get records from ASEG x-ref

 S IVMI=0 F  S IVMI=$O(^IVM(301.5,"ASEG","IN1",IVMI)) Q:'IVMI  D

 .S IVMJ=0 F  S IVMJ=$O(^IVM(301.5,"ASEG","IN1",IVMI,IVMJ)) Q:'IVMJ  D

 ..;

 ..S IVMCTR=IVMCTR+1 W:'(IVMCTR#15) "."

 ..;

 ..; - get node from IVM Patient (#301.5) file

 ..S IVM0NOD=$G(^IVM(301.5,IVMI,0)) I IVM0NOD']"" Q

 ..S DFN=+IVM0NOD

 ..;

 ..; - get HL7 segment string from (#301.511) sub-file

 ..S IVMSEG=$G(^IVM(301.5,IVMI,"IN",IVMJ,"ST")) I IVMSEG']"" Q

 ..S:$D(^IVM(301.5,IVMI,"IN",IVMJ,"ST1")) IVMSEG=IVMSEG_$G(^IVM(301.5,IVMI,"IN",IVMJ,"ST1"))

 ..;

 ..; - check for zeroth node Patient (#2) file

 ..I $G(^DPT(+DFN,0))']"" Q

 ..;

 ..; - get patient name and ssn

 ..S IVMNAME=$P($$PT^IVMUFNC4(DFN),"^"),IVMSSN=$P($$PT^IVMUFNC4(DFN),"^",2)

 ..;

 ..; - check for date of death from IVM

 ..S IVMDOD=$S($P($P($G(^IVM(301.5,IVMI,"IN",IVMJ,0)),"^",7),"/",2)]"":$P($P($G(^IVM(301.5,IVMI,"IN",IVMJ,0)),"^",7),"/",2),1:"")

 ..;

 ..; - check if patient has active insurance

 ..S IVMINS=$$INSUR^IBBAPI(DFN,DT),IVMINS=$S(IVMINS=1:"YES",1:"NO")

 ..;

 ..; - build line for list manager display

 ..D BLDLINE

 ;

 I IVMCTR=0 W !!,"There is no IVM insurance data to be uploaded at this time.",!,*7

 ;

BLDQ ; - clean up variables

 K DFN,IVM0NOD,IVMDOD,IVMINS,IVMNAME,IVMREC,IVMSEG,IVMSSN

 Q

 ;

 ;

BLDLINE ; - build storage array with data for list manager (called from BLD)

 S ^TMP("IVMIUPL",$J,IVMNAME,IVMI,IVMJ)=DFN_"^"_IVMSSN_"^"_IVMINS_"^"_$P(IVMSEG,HLFS,4)_"^"_$P(IVMSEG,HLFS,36)_"^"_IVMDOD

 ;

 ; ^tmp("ivmiupl",$j,pat name, ivm ien, ivm sub ien)=dfn^ssn^active insurance^ins company^subscriber id^ivm date of death

 Q

 ;

 ;

HDR ; - header code for list manager display

 S VALMHDR(1)="HEC has identified insurance for the following patients:"

 S VALMHDR(2)="   (*) - Indicates Death Reported  Act"

 Q

 ;

 ;

INIT ; - init variables and list array

 K ^TMP("IVMLST",$J)

 ;

 ; - set up blank line for padding display fields and init counter

 S IVMBL="",$P(IVMBL," ",40)="",IVMCTR=0

 ;

 S IVMNAME="" F  S IVMNAME=$O(^TMP("IVMIUPL",$J,IVMNAME)) Q:IVMNAME']""  S IVMI1="" D

 .F  S IVMI1=$O(^TMP("IVMIUPL",$J,IVMNAME,IVMI1)) Q:'IVMI1  S IVMJ1="" D

 ..F  S IVMJ1=$O(^TMP("IVMIUPL",$J,IVMNAME,IVMI1,IVMJ1)) Q:'IVMJ1  D

 ...;

 ...; - node from the data storage array

 ...S IVMLN=$G(^TMP("IVMIUPL",$J,IVMNAME,IVMI1,IVMJ1))

 ...;

 ...S IVMSTAR=$S($P(IVMLN,"^",6)]"":"*",$P($G(^DPT(+$P(IVMLN,"^"),.35)),"^")]"":"*",1:" ")

 ...;

 ...; - line for display

 ...S DFN=$P(IVMLN,"^"),IVMLN=$E(IVMNAME,1,25)_"^"_$P(IVMLN,"^",2,99)

 ...;

 ...; - increment counter and write line

 ...S IVMCTR=IVMCTR+1 D WRLN(IVMLN,IVMCTR)

 ...;

 ...; - create index array for look up

 ...S ^TMP("IVMLST",$J,"IDX",IVMCTR,IVMCTR)=IVMNAME_"^"_$P(IVMLN,"^",2)_"^"_IVMI1_"^"_IVMJ1

 ...; ^tmp("ivmlst",$j,"idx",counter,counter)=pat name^pat ssn^ien (#301.5) file^ien (#301.501) sub file

 ;

 ; - VALMCNT as the number of lines in the list

 S VALMCNT=IVMCTR

 ;

INTQ ; - clean up variables

 K DFN,IVMBL,IVMCTR,IVMI,IVMI1,IVMJ,IVMJ1,IVMLN,IVMNAME,IVMSSN,IVMSTAR,LINE,NUMBER

 Q

 ;

 ;

WRLN(LINE,NUMBER) ; - write line out for list manager display

 ;

 ;  Input:    LINE  --  as pat name^pat ssn^active ins^ins carrier^subscriber id

 ;          NUMBER  --  as line number

 ;

 ; Output:  None

 ;

 N IVMLN

 S IVMLN=$E(IVMSTAR_$P(LINE,"^",1)_IVMBL,1,16)_"  "_$E($P(LINE,"^",2)_IVMBL,1,11)_"  "_$E($P(LINE,"^",3)_IVMBL,1,3)_"  "_$E($P(LINE,"^",4)_IVMBL,1,24)_"  "_$P(LINE,"^",5)

 S @VALMAR@(NUMBER,0)=$E(NUMBER_"     ",1,4)_IVMLN

 Q

 ;

 ;

HELP ; - help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

 ;

EXIT ; - exit code

 K ^TMP("IVMLST",$J),^TMP("IVMIUPL",$J)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IVMLINS   4341     printed  Feb 18, 2025@23:27:33                                                                                                                                                                                                     Page 2

IVMLINS   ;ALB/KCL,PHH - IVM INSURANCE UPLOAD ; 14-JAN-94

 +1       ;;2.0;INCOME VERIFICATION MATCH;**14,94**; 21-OCT-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

 +4       ;

EN        ; - main entry point for IVM INSURANCE UPLOAD

 +1        DO BLD

 +2       ;

 +3       ; - if no patients in ASEG x-ref goto EXIT

 +4        IF IVMCTR=0

               GOTO EXIT

 +5       ;

 +6        SET IVMINSUP=1

 +7       ;

 +8       ; - call list manager

 +9        DO EN^VALM("IVM INSURANCE UPLOAD")

 +10      ;

 +11       KILL IVMINSUP

 +12       QUIT 

 +13      ;

 +14      ;

BLD       ; - build an array of patients with uploadable insurance data

 +1        KILL ^TMP("IVMIUPL",$JOB)

 +2        WRITE !,"Building patient list for display..."

 +3       ;

 +4       ; - change (HLFS) if HL7 segment sep ever changes!

 +5        SET IVMCTR=0

           SET HLFS="^"

 +6       ;

 +7       ; - get records from ASEG x-ref

 +8        SET IVMI=0

           FOR 

               SET IVMI=$ORDER(^IVM(301.5,"ASEG","IN1",IVMI))

               if 'IVMI

                   QUIT 

               Begin DoDot:1

 +9                SET IVMJ=0

                   FOR 

                       SET IVMJ=$ORDER(^IVM(301.5,"ASEG","IN1",IVMI,IVMJ))

                       if 'IVMJ

                           QUIT 

                       Begin DoDot:2

 +10      ;

 +11                       SET IVMCTR=IVMCTR+1

                           if '(IVMCTR#15)

                               WRITE "."

 +12      ;

 +13      ; - get node from IVM Patient (#301.5) file

 +14                       SET IVM0NOD=$GET(^IVM(301.5,IVMI,0))

                           IF IVM0NOD']""

                               QUIT 

 +15                       SET DFN=+IVM0NOD

 +16      ;

 +17      ; - get HL7 segment string from (#301.511) sub-file

 +18                       SET IVMSEG=$GET(^IVM(301.5,IVMI,"IN",IVMJ,"ST"))

                           IF IVMSEG']""

                               QUIT 

 +19                       if $DATA(^IVM(301.5,IVMI,"IN",IVMJ,"ST1"))

                               SET IVMSEG=IVMSEG_$GET(^IVM(301.5,IVMI,"IN",IVMJ,"ST1"))

 +20      ;

 +21      ; - check for zeroth node Patient (#2) file

 +22                       IF $GET(^DPT(+DFN,0))']""

                               QUIT 

 +23      ;

 +24      ; - get patient name and ssn

 +25                       SET IVMNAME=$PIECE($$PT^IVMUFNC4(DFN),"^")

                           SET IVMSSN=$PIECE($$PT^IVMUFNC4(DFN),"^",2)

 +26      ;

 +27      ; - check for date of death from IVM

 +28                       SET IVMDOD=$SELECT($PIECE($PIECE($GET(^IVM(301.5,IVMI,"IN",IVMJ,0)),"^",7),"/",2)]"":$PIECE($PIECE($GET(^IVM(301.5,IVMI,"IN",IVMJ,0)),"^",7),"/",2),1:"")

 +29      ;

 +30      ; - check if patient has active insurance

 +31                       SET IVMINS=$$INSUR^IBBAPI(DFN,DT)

                           SET IVMINS=$SELECT(IVMINS=1:"YES",1:"NO")

 +32      ;

 +33      ; - build line for list manager display

 +34                       DO BLDLINE

                       End DoDot:2

               End DoDot:1

 +35      ;

 +36       IF IVMCTR=0

               WRITE !!,"There is no IVM insurance data to be uploaded at this time.",!,*7

 +37      ;

BLDQ      ; - clean up variables

 +1        KILL DFN,IVM0NOD,IVMDOD,IVMINS,IVMNAME,IVMREC,IVMSEG,IVMSSN

 +2        QUIT 

 +3       ;

 +4       ;

BLDLINE   ; - build storage array with data for list manager (called from BLD)

 +1        SET ^TMP("IVMIUPL",$JOB,IVMNAME,IVMI,IVMJ)=DFN_"^"_IVMSSN_"^"_IVMINS_"^"_$PIECE(IVMSEG,HLFS,4)_"^"_$PIECE(IVMSEG,HLFS,36)_"^"_IVMDOD

 +2       ;

 +3       ; ^tmp("ivmiupl",$j,pat name, ivm ien, ivm sub ien)=dfn^ssn^active insurance^ins company^subscriber id^ivm date of death

 +4        QUIT 

 +5       ;

 +6       ;

HDR       ; - header code for list manager display

 +1        SET VALMHDR(1)="HEC has identified insurance for the following patients:"

 +2        SET VALMHDR(2)="   (*) - Indicates Death Reported  Act"

 +3        QUIT 

 +4       ;

 +5       ;

INIT      ; - init variables and list array

 +1        KILL ^TMP("IVMLST",$JOB)

 +2       ;

 +3       ; - set up blank line for padding display fields and init counter

 +4        SET IVMBL=""

           SET $PIECE(IVMBL," ",40)=""

           SET IVMCTR=0

 +5       ;

 +6        SET IVMNAME=""

           FOR 

               SET IVMNAME=$ORDER(^TMP("IVMIUPL",$JOB,IVMNAME))

               if IVMNAME']""

                   QUIT 

               SET IVMI1=""

               Begin DoDot:1

 +7                FOR 

                       SET IVMI1=$ORDER(^TMP("IVMIUPL",$JOB,IVMNAME,IVMI1))

                       if 'IVMI1

                           QUIT 

                       SET IVMJ1=""

                       Begin DoDot:2

 +8                        FOR 

                               SET IVMJ1=$ORDER(^TMP("IVMIUPL",$JOB,IVMNAME,IVMI1,IVMJ1))

                               if 'IVMJ1

                                   QUIT 

                               Begin DoDot:3

 +9       ;

 +10      ; - node from the data storage array

 +11                               SET IVMLN=$GET(^TMP("IVMIUPL",$JOB,IVMNAME,IVMI1,IVMJ1))

 +12      ;

 +13                               SET IVMSTAR=$SELECT($PIECE(IVMLN,"^",6)]"":"*",$PIECE($GET(^DPT(+$PIECE(IVMLN,"^"),.35)),"^")]"":"*",1:" ")

 +14      ;

 +15      ; - line for display

 +16                               SET DFN=$PIECE(IVMLN,"^")

                                   SET IVMLN=$EXTRACT(IVMNAME,1,25)_"^"_$PIECE(IVMLN,"^",2,99)

 +17      ;

 +18      ; - increment counter and write line

 +19                               SET IVMCTR=IVMCTR+1

                                   DO WRLN(IVMLN,IVMCTR)

 +20      ;

 +21      ; - create index array for look up

 +22                               SET ^TMP("IVMLST",$JOB,"IDX",IVMCTR,IVMCTR)=IVMNAME_"^"_$PIECE(IVMLN,"^",2)_"^"_IVMI1_"^"_IVMJ1

 +23      ; ^tmp("ivmlst",$j,"idx",counter,counter)=pat name^pat ssn^ien (#301.5) file^ien (#301.501) sub file

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +24      ;

 +25      ; - VALMCNT as the number of lines in the list

 +26       SET VALMCNT=IVMCTR

 +27      ;

INTQ      ; - clean up variables

 +1        KILL DFN,IVMBL,IVMCTR,IVMI,IVMI1,IVMJ,IVMJ1,IVMLN,IVMNAME,IVMSSN,IVMSTAR,LINE,NUMBER

 +2        QUIT 

 +3       ;

 +4       ;

WRLN(LINE,NUMBER) ; - write line out for list manager display

 +1       ;

 +2       ;  Input:    LINE  --  as pat name^pat ssn^active ins^ins carrier^subscriber id

 +3       ;          NUMBER  --  as line number

 +4       ;

 +5       ; Output:  None

 +6       ;

 +7        NEW IVMLN

 +8        SET IVMLN=$EXTRACT(IVMSTAR_$PIECE(LINE,"^",1)_IVMBL,1,16)_"  "_$EXTRACT($PIECE(LINE,"^",2)_IVMBL,1,11)_"  "_$EXTRACT($PIECE(LINE,"^",3)_IVMBL,1,3)_"  "_$EXTRACT($PIECE(LINE,"^",4)_IVMBL,1,24)_"  "_$PIECE(LINE,"^",5)

 +9        SET @VALMAR@(NUMBER,0)=$EXTRACT(NUMBER_"     ",1,4)_IVMLN

 +10       QUIT 

 +11      ;

 +12      ;

HELP      ; - help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

 +4       ;

EXIT      ; - exit code

 +1        KILL ^TMP("IVMLST",$JOB),^TMP("IVMIUPL",$JOB)

 +2        QUIT