source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMLDEMU.m@ 824

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

initial load of WorldVistAEHR
File size: 3.3 KB
RevLine 
[613]1IVMLDEMU ;ALB/KCL - IVM DEMOGRAPHIC UPLOAD UTILITIES ; 05-MAY-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 ;
7UPLOAD(DFN,IVMPTR,IVMFIELD,IVMVALUE) ; - file demographic fields received from IVM
8 ;
9 ; Input: DFN -- as patient IEN
10 ; IVMPTR -- as pointer to the FILE (#1) file.
11 ; IVMFIELD -- as the field number to be updated
12 ; IVMVALUE -- as the value of the field
13 ;
14 ; Output: None
15 ;
16 N DA,DIE,DR,X
17 Q:'$D(DFN)!('$D(IVMPTR))!('$D(IVMFIELD))!('$D(IVMVALUE))
18 S DIE=$G(^DIC(IVMPTR,0,"GL")) Q:DIE']""
19 S DA=DFN,DR=IVMFIELD_"////^S X=IVMVALUE"
20 D ^DIE
21 Q
22 ;
23 ;
24DELENT(IVMSUB2,IVMSUB1,IVMSUB) ; - delete entry - demographic upload data from (#301.5) sub-file
25 ;
26 ; Input: IVMSUB2 -- as DA(2) of (#301.511) sub-file
27 ; IVMSUB1 -- as DA(1) of (#301.511) sub-file
28 ; IVMSUB -- as DA of (#301.511) sub-file
29 ;
30 ; Output: None
31 ;
32 N DA,DIK,X,Y
33 S DA(1)=IVMSUB1,DA(2)=IVMSUB2,DA=IVMSUB
34 S DIK="^IVM(301.5,"_DA(2)_",""IN"","_DA(1)_",""DEM"","
35 D ^DIK
36 Q
37 ;
38 ;
39RUSURE(IVMFIELD,IVMACT) ; - are you sure about the action?
40 ;
41 ;
42 ; Input: IVMWHERE -- "NON" for a non-uploadable field
43 ; "UP" for a uploadable field
44 ; IVMFIELD -- Free-text name of field to be deleted
45 ; IVMACT -- as action taken 'update' or 'delete'
46 ;
47 ; Output: IVMOUT -- 1 for '^', 2 for time-out, 0 otherwise
48 ; IVMSURE -- 1 for 'YES', 0 for 'NO'
49 ;
50 ; - set screen to full scrolling region
51 D FULL^VALM1
52 ;
53 S:$G(IVMFIELD)="" IVMFIELD="<FIELD UNSPECIFIED>"
54 ;
55 ; - programmer supplied prompt
56 W ! S DIR("A")="Okay to "_IVMACT_" the "_IVMFIELD_" field",DIR(0)="Y"
57 ;
58 ; - set array of additional help if user enters single '?'
59 I IVMACT="delete" D
60 .S DIR("?",1)="If 'Y'es is entered at this prompt, the entry will be removed from the list."
61 .S DIR("?",2)="If 'N'o is entered at this prompt, the entry will remain on the list."
62 .S DIR("?",3)="Once an entry has been purged from the list, any upload data for that entry "
63 .S DIR("?")="will be deleted."
64 ;
65 ; - set array of additional help if user enters single '?'
66 I IVMACT="update" D
67 .S DIR("?",1)="If 'Y'es is entered at this prompt, the field will be updated and"
68 .S DIR("?",2)="the entry will be removed from the list."
69 .S DIR("?",3)=" "
70 .S DIR("?",4)="If 'N'o is entered at this prompt, the entry will remain on the list."
71 .S DIR("?",5)=""
72 .S DIR("?",6)="An entry will remain on the list untill an 'UF' - Upload Field action or a"
73 .S DIR("?")="'DF' - Delete Field action has been completed."
74 ;
75 ; - set default='YES'
76 S DIR("B")="YES"
77 D ^DIR
78 S IVMSURE=$G(Y)
79 S IVMOUT=$S($D(DTOUT):2,$D(DUOUT):1,$D(DIROUT):1,1:0)
80 ;
81 ; - refresh the screen and reset the scrolling region
82 S VALMBCK="R"
83 ;
84 K DIR,DIROUT,DTOUT,DUOUT,Y
85 Q
86 ;
87RESET ; Reset IVMENT4 before returning to routine IVMLDEM4.
88 ; Input: IVMENT4
89 ; VALMY array
90 ; Output: A re-set value of IVMENT4
91 N IND,X
92 S X=IVMENT4 F S X=$O(VALMY(X)) Q:'X S IND=$$ADDR(X) Q:'IND S IVMENT4=X
93 Q
94 ;
95ADDR(X) ; Is the corresponding field an address?
96 ; Input: X -- VALMY subscript which is an array index
97 ; Output: 1 -- Yes
98 ; 0 -- No
99 N PTR,Y
100 S Y=$G(^TMP("IVMUPLOAD",$J,"IDX",X,X))
101 S PTR=+$O(^IVM(301.92,"B",$P(Y,"^",8),0))
102 Q $D(^IVM(301.92,"AD",PTR))>0
Note: See TracBrowser for help on using the repository browser.