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 ---[H[J[2J[HIVMLSU2 3553 printed Dec 13, 2024@02:02:05 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
