IVMLSU2.m

IVMLSU2 ;ALB/MLI/KCL - IVM SSA/SSN UPLOAD OR PURGE ENTRIES ; 07-JAN-94

 ;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94

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

 ;

 ; This routine contains the code to execute the mneumonics on the

 ; list manager option.  The line tag equals the mneumonic (and is

 ; followed by a line mneumonic_Q which is the kill line for the

 ; tag).

 ;

 ;

PU ; - (Action) Purge entries from list if inappropriate for uploading

 ;

 ;  Input - ^TMP("IVMLST",$J,"IDX",#,#)=pt name_pt ssn_dfn_sp ien_date of death_da(1)_da

 ;          VALMY(n)=array of selections

 ;

 S IVMOUT=0,IVMWHERE="PU"

 ;

 ; - generic selector used within a list manager action call

 D EN^VALM2($G(XQORNOD(0)),"S")

 Q:'$D(VALMY)

 S IVMENT=0 F  S IVMENT=$O(VALMY(IVMENT)) Q:'IVMENT!IVMOUT  D

 .S IVMND=$G(^TMP("IVMLST",$J,"IDX",IVMENT,IVMENT)) I IVMND']"" Q

 .S IVMNM=$P(IVMND,"^",1),IVMSSN=$P(IVMND,"^",2)

 .S IVMI=$P(IVMND,"^",6),IVMJ=$P(IVMND,"^",7)

 .W !,"Purge for patient: ",IVMNM

 .;

 .; - alert user if date of death

 .I $P(IVMND,"^",5)]"" D DOD

 .;

 .D RUSURE^IVMLSU3 I 'IVMSURE Q

 .W !,"Update SSN's for ",IVMNM

 .D DELENT^IVMLSU3

 .W " ...deleted.",!

 .S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR

PUQ D QUIT

 Q

 ;

 ;

UP ; - (Action) Upload data for patient

 ;

 ;  Input - ^TMP("IVMLST",$J,"IDX",#,#)=pt name_pt ssn_dfn_sp ien_date of death_da(1)_da

 ;          VALMY(n)=array of selections

 ;

 ;

 S IVMOUT=0,IVMWHERE="UP"

 ;

 ; - generic selector used within a list manager action call

 D EN^VALM2($G(XQORNOD(0)),"S")

 Q:'$D(VALMY)

 S IVMENT=0 F  S IVMENT=$O(VALMY(IVMENT)) Q:'IVMENT!IVMOUT  D

 .S IVMND=$G(^TMP("IVMLST",$J,"IDX",IVMENT,IVMENT)) I IVMND']"" Q

 .S IVMNM=$P(IVMND,"^",1),IVMSSN=$P(IVMND,"^",2)

 .S IVMI=$P(IVMND,"^",6),IVMJ=$P(IVMND,"^",7)

 .; - get data node

 .S IVMDND=^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ)

 .S DFN=$P(IVMDND,"^",1),IVMSIEN=$P(IVMDND,"^",2),IVMLINE=$P(IVMDND,"^",4,99)

 .S IVMVSSN=$P(IVMLINE,"^",3),IVMSSSN=$P(IVMLINE,"^",6)

 .S IVMUP=$S(IVMVSSN&IVMSSSN:"B",IVMVSSN:"V",1:"S")

 .W !,"Update for patient: ",IVMNM

 .;

 .; - alert user if date of death

 .I $P(IVMND,"^",5)]"" D DOD

 .;

 .I IVMUP="B" D BOTH I IVMOUT Q

 .;

 .D RUSURE^IVMLSU3 I IVMOUT!'IVMSURE Q

 .D SSNUP^IVMLSU3

UPQ D QUIT

 Q

 ;

 ;

QUIT ; - Kill variables used from all protocols

 ;

 ; - reset array for display

 D INIT^IVMLSU1

 ;

 S VALMBCK=$S(IVMOUT'=2:"R",1:"Q") ; redisplay or quit if timeout

 K DFN,IVMDND,IVMENT,IVMI,IVMJ,IVMLINE,IVMND,IVMNM,IVMOUT

 K IVMSSN,IVMSSSN,IVMSURE,IVMUP,IVMVSSN,IVMWHERE

 Q

 ;

 ;

BOTH ; - Upload both ssn's?

 ;

 ;  Input - None

 ; Output - IVMUP as V for vet, S for spouse, B for both

 ;          IVMOUT = 1 for '^', 2 for time-out, 0 otherwise

 ;

 N X,Y

 S DIR("A")="Update the SSN for the 'V'eteran, 'S'pouse, or 'B'oth?",DIR(0)="SB^V:VETERAN;S:SPOUSE;B:BOTH"

 S DIR("?",1)="Answer 'V' to upload veteran SSN only, 'S' to upload spouse SSN only",DIR("?")="or 'B' to upload the SSN for both the veteran and the spouse"

 S DIR("B")="BOTH" ; default both

 D ^DIR

 S IVMOUT=$S($D(DTOUT):2,$D(DUOUT):1,$D(DIROUT):1,1:0)

 S IVMUP=$G(Y) I IVMUP="B" S IVMUP="VS"

 K DIR,DIROUT,DTOUT,DUOUT

 Q

 ;

 ;

DOD ; - Alert user of date of death reported in DHCP or from IVM Center

 ;

 W !,*7,"'Date of Death' reported for this patient "

 W $S($E($P(IVMND,"^",5))="I":"by the IVM Center",$E($P(IVMND,"^",5))="D":"in DHCP")_" as "_$$DAT2^IVMUFNC4($E($P(IVMND,"^",5),2,99))_".",!

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IVMLSU2   3553     printed  Feb 18, 2025@23:27:40                                                                                                                                                                                                     Page 2

IVMLSU2   ;ALB/MLI/KCL - IVM SSA/SSN UPLOAD OR PURGE ENTRIES ; 07-JAN-94

 +1       ;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94

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

 +3       ;

 +4       ; This routine contains the code to execute the mneumonics on the

 +5       ; list manager option.  The line tag equals the mneumonic (and is

 +6       ; followed by a line mneumonic_Q which is the kill line for the

 +7       ; tag).

 +8       ;

 +9       ;

PU        ; - (Action) Purge entries from list if inappropriate for uploading

 +1       ;

 +2       ;  Input - ^TMP("IVMLST",$J,"IDX",#,#)=pt name_pt ssn_dfn_sp ien_date of death_da(1)_da

 +3       ;          VALMY(n)=array of selections

 +4       ;

 +5        SET IVMOUT=0

           SET IVMWHERE="PU"

 +6       ;

 +7       ; - generic selector used within a list manager action call

 +8        DO EN^VALM2($GET(XQORNOD(0)),"S")

 +9        if '$DATA(VALMY)

               QUIT 

 +10       SET IVMENT=0

           FOR 

               SET IVMENT=$ORDER(VALMY(IVMENT))

               if 'IVMENT!IVMOUT

                   QUIT 

               Begin DoDot:1

 +11               SET IVMND=$GET(^TMP("IVMLST",$JOB,"IDX",IVMENT,IVMENT))

                   IF IVMND']""

                       QUIT 

 +12               SET IVMNM=$PIECE(IVMND,"^",1)

                   SET IVMSSN=$PIECE(IVMND,"^",2)

 +13               SET IVMI=$PIECE(IVMND,"^",6)

                   SET IVMJ=$PIECE(IVMND,"^",7)

 +14               WRITE !,"Purge for patient: ",IVMNM

 +15      ;

 +16      ; - alert user if date of death

 +17               IF $PIECE(IVMND,"^",5)]""

                       DO DOD

 +18      ;

 +19               DO RUSURE^IVMLSU3

                   IF 'IVMSURE

                       QUIT 

 +20               WRITE !,"Update SSN's for ",IVMNM

 +21               DO DELENT^IVMLSU3

 +22               WRITE " ...deleted.",!

 +23               SET DIR(0)="E"

                   SET DIR("A")="Press RETURN to continue"

                   DO ^DIR

                   KILL DIR

               End DoDot:1

PUQ        DO QUIT

 +1        QUIT 

 +2       ;

 +3       ;

UP        ; - (Action) Upload data for patient

 +1       ;

 +2       ;  Input - ^TMP("IVMLST",$J,"IDX",#,#)=pt name_pt ssn_dfn_sp ien_date of death_da(1)_da

 +3       ;          VALMY(n)=array of selections

 +4       ;

 +5       ;

 +6        SET IVMOUT=0

           SET IVMWHERE="UP"

 +7       ;

 +8       ; - generic selector used within a list manager action call

 +9        DO EN^VALM2($GET(XQORNOD(0)),"S")

 +10       if '$DATA(VALMY)

               QUIT 

 +11       SET IVMENT=0

           FOR 

               SET IVMENT=$ORDER(VALMY(IVMENT))

               if 'IVMENT!IVMOUT

                   QUIT 

               Begin DoDot:1

 +12               SET IVMND=$GET(^TMP("IVMLST",$JOB,"IDX",IVMENT,IVMENT))

                   IF IVMND']""

                       QUIT 

 +13               SET IVMNM=$PIECE(IVMND,"^",1)

                   SET IVMSSN=$PIECE(IVMND,"^",2)

 +14               SET IVMI=$PIECE(IVMND,"^",6)

                   SET IVMJ=$PIECE(IVMND,"^",7)

 +15      ; - get data node

 +16               SET IVMDND=^TMP("IVMUP",$JOB,IVMNM,IVMSSN,IVMI,IVMJ)

 +17               SET DFN=$PIECE(IVMDND,"^",1)

                   SET IVMSIEN=$PIECE(IVMDND,"^",2)

                   SET IVMLINE=$PIECE(IVMDND,"^",4,99)

 +18               SET IVMVSSN=$PIECE(IVMLINE,"^",3)

                   SET IVMSSSN=$PIECE(IVMLINE,"^",6)

 +19               SET IVMUP=$SELECT(IVMVSSN&IVMSSSN:"B",IVMVSSN:"V",1:"S")

 +20               WRITE !,"Update for patient: ",IVMNM

 +21      ;

 +22      ; - alert user if date of death

 +23               IF $PIECE(IVMND,"^",5)]""

                       DO DOD

 +24      ;

 +25               IF IVMUP="B"

                       DO BOTH

                       IF IVMOUT

                           QUIT 

 +26      ;

 +27               DO RUSURE^IVMLSU3

                   IF IVMOUT!'IVMSURE

                       QUIT 

 +28               DO SSNUP^IVMLSU3

               End DoDot:1

UPQ        DO QUIT

 +1        QUIT 

 +2       ;

 +3       ;

QUIT      ; - Kill variables used from all protocols

 +1       ;

 +2       ; - reset array for display

 +3        DO INIT^IVMLSU1

 +4       ;

 +5       ; redisplay or quit if timeout

           SET VALMBCK=$SELECT(IVMOUT'=2:"R",1:"Q")

 +6        KILL DFN,IVMDND,IVMENT,IVMI,IVMJ,IVMLINE,IVMND,IVMNM,IVMOUT

 +7        KILL IVMSSN,IVMSSSN,IVMSURE,IVMUP,IVMVSSN,IVMWHERE

 +8        QUIT 

 +9       ;

 +10      ;

BOTH      ; - Upload both ssn's?

 +1       ;

 +2       ;  Input - None

 +3       ; Output - IVMUP as V for vet, S for spouse, B for both

 +4       ;          IVMOUT = 1 for '^', 2 for time-out, 0 otherwise

 +5       ;

 +6        NEW X,Y

 +7        SET DIR("A")="Update the SSN for the 'V'eteran, 'S'pouse, or 'B'oth?"

           SET DIR(0)="SB^V:VETERAN;S:SPOUSE;B:BOTH"

 +8        SET DIR("?",1)="Answer 'V' to upload veteran SSN only, 'S' to upload spouse SSN only"

           SET DIR("?")="or 'B' to upload the SSN for both the veteran and the spouse"

 +9       ; default both

           SET DIR("B")="BOTH"

 +10       DO ^DIR

 +11       SET IVMOUT=$SELECT($DATA(DTOUT):2,$DATA(DUOUT):1,$DATA(DIROUT):1,1:0)

 +12       SET IVMUP=$GET(Y)

           IF IVMUP="B"

               SET IVMUP="VS"

 +13       KILL DIR,DIROUT,DTOUT,DUOUT

 +14       QUIT 

 +15      ;

 +16      ;

DOD       ; - Alert user of date of death reported in DHCP or from IVM Center

 +1       ;

 +2        WRITE !,*7,"'Date of Death' reported for this patient "

 +3        WRITE $SELECT($EXTRACT($PIECE(IVMND,"^",5))="I":"by the IVM Center",$EXTRACT($PIECE(IVMND,"^",5))="D":"in DHCP")_" as "_$$DAT2^IVMUFNC4($EXTRACT($PIECE(IVMND,"^",5),2,99))_".",!

 +4        QUIT