source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMLSU3.m@ 724

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1IVMLSU3 ;ALB/MLI/KCL - IVM Functions from List Manager Application ; 7 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 ;
6 ;
7SSNUP ; - upload selected SSNs, reset data in array/file
8 N X
9 I 'IVMVSSN!(IVMUP'["V") G SPOUSE
10 S X=$O(^DPT("SSN",IVMVSSN,0)),X=$$PT^IVMUFNC4(+X)
11 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
12 S DA=DFN,DIE="^DPT(",DR=".09///^S X=IVMVSSN" D ^DIE
13 W !!?3,"...patient Social Security Number (SSN) has been updated.",!
14 S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
15 ;
16 ; - delete ssa/ssn for patient in the list man array
17 S $P(^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ),"^",6)=""
18 ;
19 ;
20SPOUSE ; - spouse ssn update (falls through)
21 ;
22 I 'IVMSIEN!(IVMUP'["S") G SSNUPQ
23 S X=$P($G(^DGPR(408.12,IVMSIEN,0)),"^",3)
24 S DA=+X,DIE="^"_$P(X,";",2),DR=".09///"_IVMSSSN D ^DIE
25 W !!?3,"...spouse's Social Security Number (SSN) has been updated.",!
26 S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR K DIR
27 ;
28 ; - delete spouse fields from list man array
29 S $P(^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ),"^",7)="",$P(^(IVMJ),"^",8)="",$P(^(IVMJ),"^",9)=""
30 ;
31 ;
32SSNUPQ ; - if no ssa/ssn for the patient and spouse - delete entry from list
33 S X=^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ)
34 I '$P(X,"^",6),'$P(X,"^",9) D DELENT
35 K DA,DIE,DR,Y
36 Q
37 ;
38 ;
39DELENT ; - once entry is purged or uploaded - delete entry from (#301.5)
40 ; file and delete from list man array
41 ;
42 ; Input: IVMND -- as pt name^pt ssn^dfn^sp ien^date of death^da(1)^da
43 ;
44 N X,Y
45 K ^TMP("IVMUP",$J,IVMNM,IVMSSN,IVMI,IVMJ)
46 S DA(1)=IVMI,DA=IVMJ,DIK="^IVM(301.5,"_DA(1)_",""IN"","
47 D ^DIK
48 K DA,DIC,DIK
49 Q
50 ;
51 ;
52RUSURE ; - Are you sure about UP-upload or PU-purge actions?
53 ;
54 ; Input - IVMWHERE = "PU" if from purge, "UP" if from update
55 ; Output - IVMOUT = 1 for '^', 2 for time-out, 0 otherwise
56 ; IVMSURE = 1 for yes, 0 for no
57 ;
58 N X,Y
59 ;
60 ; - set screen to full scrolling region
61 D FULL^VALM1
62 W !
63 S IVMACT=$S(IVMWHERE="PU":"purge",1:"update")
64 S DIR("A")="Are you sure you want to "_IVMACT_" this entry",DIR(0)="Y"
65 ;
66 ; - purge help
67 I IVMACT="purge" D
68 .S DIR("?",1)="Entering 'YES' at this prompt will cause the entire entry to"
69 .S DIR("?",2)="be removed from the list. Purging an entry will delete the"
70 .S DIR("?",3)="SSA/SSN's that have been received from the IVM Center, for"
71 .S DIR("?",4)="both the patient and his or her spouse."
72 .S DIR("?",5)=" "
73 .S DIR("?",6)="Entering 'NO' at this prompt will cause the entry to remain on"
74 .S DIR("?",7)="the list. The entry will remain on the list until either an"
75 .S DIR("?")="'UPDATE' or 'PURGE' action has been taken"
76 ;
77 ; - update help
78 I IVMACT="update" D
79 .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.")
80 .S DIR("?",2)=" "
81 .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.")
82 .S DIR("?",4)="to remain on the list."
83 .S DIR("?",5)=" "
84 .S DIR("?",6)="Once an SSN has been updated, the entry will be removed from the"
85 .S DIR("?",7)="list and the patient record will be updated with the SSA/SSN that"
86 .S DIR("?")="was received from the IVM Center."
87 S DIR("B")="NO"
88 D ^DIR
89 S IVMSURE=$G(Y)
90 S IVMOUT=$S($D(DTOUT):2,$D(DUOUT):1,$D(DIROUT):1,1:0)
91 K DIR,DIROUT,DTOUT,DUOUT,IVMACT
92 Q
Note: See TracBrowser for help on using the repository browser.