IVMLSU3 ;ALB/MLI/KCL - IVM Functions from List Manager Application ; 7 Jan 94
;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
;;Per VHA Directive 10-93-142, this routine should not be modified.
;
;
;
SSNUP ; - upload selected SSNs, reset data in array/file
N X
I 'IVMVSSN!(IVMUP'["V") G SPOUSE
S X=$O(^DPT("SSN",IVMVSSN,0)),X=$$PT^IVMUFNC4(+X)
I X]"" W !!,*7,"Social Security Number: "_$P(X,"^",2)_" is currently on file!" W !,"This SSN is in use by patient: ",$P(X,"^",1) D PAUSE^VALM1 G SPOUSE
S DA=DFN,DIE="^DPT(",DR=".09///^S X=IVMVSSN" D ^DIE
W !!?3,"...patient Social Security Number (SSN) has been updated.",!
S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
;
; - delete ssa/ssn for patient in the list man array
S $P(^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ),"^",6)=""
;
;
SPOUSE ; - spouse ssn update (falls through)
;
I 'IVMSIEN!(IVMUP'["S") G SSNUPQ
S X=$P($G(^DGPR(408.12,IVMSIEN,0)),"^",3)
S DA=+X,DIE="^"_$P(X,";",2),DR=".09///"_IVMSSSN D ^DIE
W !!?3,"...spouse's Social Security Number (SSN) has been updated.",!
S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
;
; - delete spouse fields from list man array
S $P(^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ),"^",7)="",$P(^(IVMJ),"^",8)="",$P(^(IVMJ),"^",9)=""
;
;
SSNUPQ ; - if no ssa/ssn for the patient and spouse - delete entry from list
S X=^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ)
I '$P(X,"^",6),'$P(X,"^",9) D DELENT
K DA,DIE,DR,Y
Q
;
;
DELENT ; - once entry is purged or uploaded - delete entry from (#301.5)
; file and delete from list man array
;
; Input: IVMND -- as pt name^pt ssn^dfn^sp ien^date of death^da(1)^da
;
N X,Y
K ^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ)
S DA(1)=IVMI,DA=IVMJ,DIK="^IVM(301.5,"_DA(1)_",""IN"","
D ^DIK
K DA,DIC,DIK
Q
;
;
RUSURE ; - Are you sure about UP-upload or PU-purge actions?
;
; Input - IVMWHERE = "PU" if from purge, "UP" if from update
; Output - IVMOUT = 1 for '^', 2 for time-out, 0 otherwise
; IVMSURE = 1 for yes, 0 for no
;
N X,Y
;
; - set screen to full scrolling region
D FULL^VALM1
W !
S IVMACT=$S(IVMWHERE="PU":"purge",1:"update")
S DIR("A")="Are you sure you want to "_IVMACT_" this entry",DIR(0)="Y"
;
; - purge help
I IVMACT="purge" D
.S DIR("?",1)="Entering 'YES' at this prompt will cause the entire entry to"
.S DIR("?",2)="be removed from the list. Purging an entry will delete the"
.S DIR("?",3)="SSA/SSN's that have been received from the IVM Center, for"
.S DIR("?",4)="both the patient and his or her spouse."
.S DIR("?",5)=" "
.S DIR("?",6)="Entering 'NO' at this prompt will cause the entry to remain on"
.S DIR("?",7)="the list. The entry will remain on the list until either an"
.S DIR("?")="'UPDATE' or 'PURGE' action has been taken"
;
; - update help
I IVMACT="update" D
.S DIR("?",1)="Entering 'YES' will update the SSN for "_$S(IVMUP="S":"the spouse.",IVMUP="VS":"both the patient and the spouse.",1:"the patient.")
.S DIR("?",2)=" "
.S DIR("?",3)="Entering 'NO' will cause the SSN for "_$S(IVMUP="S":"the spouse.",IVMUP="VS":"both the patient and the spouse.",1:"the patient.")
.S DIR("?",4)="to remain on the list."
.S DIR("?",5)=" "
.S DIR("?",6)="Once an SSN has been updated, the entry will be removed from the"
.S DIR("?",7)="list and the patient record will be updated with the SSA/SSN that"
.S DIR("?")="was received from the IVM Center."
S DIR("B")="NO"
D ^DIR
S IVMSURE=$G(Y)
S IVMOUT=$S($D(DTOUT):2,$D(DUOUT):1,$D(DIROUT):1,1:0)
K DIR,DIROUT,DTOUT,DUOUT,IVMACT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMLSU3 3636 printed Dec 13, 2024@02:02:06 Page 2
IVMLSU3 ;ALB/MLI/KCL - IVM Functions from List Manager Application ; 7 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 ;
+5 ;
SSNUP ; - upload selected SSNs, reset data in array/file
+1 NEW X
+2 IF 'IVMVSSN!(IVMUP'["V")
GOTO SPOUSE
+3 SET X=$ORDER(^DPT("SSN",IVMVSSN,0))
SET X=$$PT^IVMUFNC4(+X)
+4 IF X]""
WRITE !!,*7,"Social Security Number: "_$PIECE(X,"^",2)_" is currently on file!"
WRITE !,"This SSN is in use by patient: ",$PIECE(X,"^",1)
DO PAUSE^VALM1
GOTO SPOUSE
+5 SET DA=DFN
SET DIE="^DPT("
SET DR=".09///^S X=IVMVSSN"
DO ^DIE
+6 WRITE !!?3,"...patient Social Security Number (SSN) has been updated.",!
+7 SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
KILL DIR
+8 ;
+9 ; - delete ssa/ssn for patient in the list man array
+10 SET $PIECE(^TMP("IVMUP",$JOB,IVMNM,IVMSSN,IVMI,IVMJ),"^",6)=""
+11 ;
+12 ;
SPOUSE ; - spouse ssn update (falls through)
+1 ;
+2 IF 'IVMSIEN!(IVMUP'["S")
GOTO SSNUPQ
+3 SET X=$PIECE($GET(^DGPR(408.12,IVMSIEN,0)),"^",3)
+4 SET DA=+X
SET DIE="^"_$PIECE(X,";",2)
SET DR=".09///"_IVMSSSN
DO ^DIE
+5 WRITE !!?3,"...spouse's Social Security Number (SSN) has been updated.",!
+6 SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
KILL DIR
+7 ;
+8 ; - delete spouse fields from list man array
+9 SET $PIECE(^TMP("IVMUP",$JOB,IVMNM,IVMSSN,IVMI,IVMJ),"^",7)=""
SET $PIECE(^(IVMJ),"^",8)=""
SET $PIECE(^(IVMJ),"^",9)=""
+10 ;
+11 ;
SSNUPQ ; - if no ssa/ssn for the patient and spouse - delete entry from list
+1 SET X=^TMP("IVMUP",$JOB,IVMNM,IVMSSN,IVMI,IVMJ)
+2 IF '$PIECE(X,"^",6)
IF '$PIECE(X,"^",9)
DO DELENT
+3 KILL DA,DIE,DR,Y
+4 QUIT
+5 ;
+6 ;
DELENT ; - once entry is purged or uploaded - delete entry from (#301.5)
+1 ; file and delete from list man array
+2 ;
+3 ; Input: IVMND -- as pt name^pt ssn^dfn^sp ien^date of death^da(1)^da
+4 ;
+5 NEW X,Y
+6 KILL ^TMP("IVMUP",$JOB,IVMNM,IVMSSN,IVMI,IVMJ)
+7 SET DA(1)=IVMI
SET DA=IVMJ
SET DIK="^IVM(301.5,"_DA(1)_",""IN"","
+8 DO ^DIK
+9 KILL DA,DIC,DIK
+10 QUIT
+11 ;
+12 ;
RUSURE ; - Are you sure about UP-upload or PU-purge actions?
+1 ;
+2 ; Input - IVMWHERE = "PU" if from purge, "UP" if from update
+3 ; Output - IVMOUT = 1 for '^', 2 for time-out, 0 otherwise
+4 ; IVMSURE = 1 for yes, 0 for no
+5 ;
+6 NEW X,Y
+7 ;
+8 ; - set screen to full scrolling region
+9 DO FULL^VALM1
+10 WRITE !
+11 SET IVMACT=$SELECT(IVMWHERE="PU":"purge",1:"update")
+12 SET DIR("A")="Are you sure you want to "_IVMACT_" this entry"
SET DIR(0)="Y"
+13 ;
+14 ; - purge help
+15 IF IVMACT="purge"
Begin DoDot:1
+16 SET DIR("?",1)="Entering 'YES' at this prompt will cause the entire entry to"
+17 SET DIR("?",2)="be removed from the list. Purging an entry will delete the"
+18 SET DIR("?",3)="SSA/SSN's that have been received from the IVM Center, for"
+19 SET DIR("?",4)="both the patient and his or her spouse."
+20 SET DIR("?",5)=" "
+21 SET DIR("?",6)="Entering 'NO' at this prompt will cause the entry to remain on"
+22 SET DIR("?",7)="the list. The entry will remain on the list until either an"
+23 SET DIR("?")="'UPDATE' or 'PURGE' action has been taken"
End DoDot:1
+24 ;
+25 ; - update help
+26 IF IVMACT="update"
Begin DoDot:1
+27 SET DIR("?",1)="Entering 'YES' will update the SSN for "_$SELECT(IVMUP="S":"the spouse.",IVMUP="VS":"both the patient and the spouse.",1:"the patient.")
+28 SET DIR("?",2)=" "
+29 SET DIR("?",3)="Entering 'NO' will cause the SSN for "_$SELECT(IVMUP="S":"the spouse.",IVMUP="VS":"both the patient and the spouse.",1:"the patient.")
+30 SET DIR("?",4)="to remain on the list."
+31 SET DIR("?",5)=" "
+32 SET DIR("?",6)="Once an SSN has been updated, the entry will be removed from the"
+33 SET DIR("?",7)="list and the patient record will be updated with the SSA/SSN that"
+34 SET DIR("?")="was received from the IVM Center."
End DoDot:1
+35 SET DIR("B")="NO"
+36 DO ^DIR
+37 SET IVMSURE=$GET(Y)
+38 SET IVMOUT=$SELECT($DATA(DTOUT):2,$DATA(DUOUT):1,$DATA(DIROUT):1,1:0)
+39 KILL DIR,DIROUT,DTOUT,DUOUT,IVMACT
+40 QUIT
