source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMLSU2.m@ 623

Last change on this file since 623 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.4 KB
Line 
1IVMLSU2 ;ALB/MLI/KCL - IVM SSA/SSN UPLOAD OR PURGE ENTRIES ; 07-JAN-94
2 ;;Version 2.0 ; INCOME VERIFICATION MATCH ;; 21-OCT-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ; This routine contains the code to execute the mneumonics on the
6 ; list manager option. The line tag equals the mneumonic (and is
7 ; followed by a line mneumonic_Q which is the kill line for the
8 ; tag).
9 ;
10 ;
11PU ; - (Action) Purge entries from list if inappropriate for uploading
12 ;
13 ; Input - ^TMP("IVMLST",$J,"IDX",#,#)=pt name_pt ssn_dfn_sp ien_date of death_da(1)_da
14 ; VALMY(n)=array of selections
15 ;
16 S IVMOUT=0,IVMWHERE="PU"
17 ;
18 ; - generic selector used within a list manager action call
19 D EN^VALM2($G(XQORNOD(0)),"S")
20 Q:'$D(VALMY)
21 S IVMENT=0 F S IVMENT=$O(VALMY(IVMENT)) Q:'IVMENT!IVMOUT D
22 .S IVMND=$G(^TMP("IVMLST",$J,"IDX",IVMENT,IVMENT)) I IVMND']"" Q
23 .S IVMNM=$P(IVMND,"^",1),IVMSSN=$P(IVMND,"^",2)
24 .S IVMI=$P(IVMND,"^",6),IVMJ=$P(IVMND,"^",7)
25 .W !,"Purge for patient: ",IVMNM
26 .;
27 .; - alert user if date of death
28 .I $P(IVMND,"^",5)]"" D DOD
29 .;
30 .D RUSURE^IVMLSU3 I 'IVMSURE Q
31 .W !,"Update SSN's for ",IVMNM
32 .D DELENT^IVMLSU3
33 .W " ...deleted.",!
34 .S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
35PUQ D QUIT
36 Q
37 ;
38 ;
39UP ; - (Action) Upload data for patient
40 ;
41 ; Input - ^TMP("IVMLST",$J,"IDX",#,#)=pt name_pt ssn_dfn_sp ien_date of death_da(1)_da
42 ; VALMY(n)=array of selections
43 ;
44 ;
45 S IVMOUT=0,IVMWHERE="UP"
46 ;
47 ; - generic selector used within a list manager action call
48 D EN^VALM2($G(XQORNOD(0)),"S")
49 Q:'$D(VALMY)
50 S IVMENT=0 F S IVMENT=$O(VALMY(IVMENT)) Q:'IVMENT!IVMOUT D
51 .S IVMND=$G(^TMP("IVMLST",$J,"IDX",IVMENT,IVMENT)) I IVMND']"" Q
52 .S IVMNM=$P(IVMND,"^",1),IVMSSN=$P(IVMND,"^",2)
53 .S IVMI=$P(IVMND,"^",6),IVMJ=$P(IVMND,"^",7)
54 .; - get data node
55 .S IVMDND=^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ)
56 .S DFN=$P(IVMDND,"^",1),IVMSIEN=$P(IVMDND,"^",2),IVMLINE=$P(IVMDND,"^",4,99)
57 .S IVMVSSN=$P(IVMLINE,"^",3),IVMSSSN=$P(IVMLINE,"^",6)
58 .S IVMUP=$S(IVMVSSN&IVMSSSN:"B",IVMVSSN:"V",1:"S")
59 .W !,"Update for patient: ",IVMNM
60 .;
61 .; - alert user if date of death
62 .I $P(IVMND,"^",5)]"" D DOD
63 .;
64 .I IVMUP="B" D BOTH I IVMOUT Q
65 .;
66 .D RUSURE^IVMLSU3 I IVMOUT!'IVMSURE Q
67 .D SSNUP^IVMLSU3
68UPQ D QUIT
69 Q
70 ;
71 ;
72QUIT ; - Kill variables used from all protocols
73 ;
74 ; - reset array for display
75 D INIT^IVMLSU1
76 ;
77 S VALMBCK=$S(IVMOUT'=2:"R",1:"Q") ; redisplay or quit if timeout
78 K DFN,IVMDND,IVMENT,IVMI,IVMJ,IVMLINE,IVMND,IVMNM,IVMOUT
79 K IVMSSN,IVMSSSN,IVMSURE,IVMUP,IVMVSSN,IVMWHERE
80 Q
81 ;
82 ;
83BOTH ; - Upload both ssn's?
84 ;
85 ; Input - None
86 ; Output - IVMUP as V for vet, S for spouse, B for both
87 ; IVMOUT = 1 for '^', 2 for time-out, 0 otherwise
88 ;
89 N X,Y
90 S DIR("A")="Update the SSN for the 'V'eteran, 'S'pouse, or 'B'oth?",DIR(0)="SB^V:VETERAN;S:SPOUSE;B:BOTH"
91 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"
92 S DIR("B")="BOTH" ; default both
93 D ^DIR
94 S IVMOUT=$S($D(DTOUT):2,$D(DUOUT):1,$D(DIROUT):1,1:0)
95 S IVMUP=$G(Y) I IVMUP="B" S IVMUP="VS"
96 K DIR,DIROUT,DTOUT,DUOUT
97 Q
98 ;
99 ;
100DOD ; - Alert user of date of death reported in DHCP or from IVM Center
101 ;
102 W !,*7,"'Date of Death' reported for this patient "
103 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))_".",!
104 Q
Note: See TracBrowser for help on using the repository browser.