source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMLDEM.m@ 1261

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

initial load of WorldVistAEHR

File size: 3.6 KB
Line 
1IVMLDEM ;ALB/KCL - IVM DEMOGRAPHIC UPLOAD PATIENT DISPLAY ; 11-APR-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 ;
6EN ; - main entry point
7 N IVMENT
8 D BUILD
9 I IVMCTR=0 G EXIT ; if no patients with demographic info - quit
10 D EN^VALM("IVM DEMOGRAPHIC")
11 Q
12 ;
13 ;
14BUILD ; - build an array of IVM patients with demographic data for uploading
15 K ^TMP("IVMDUPL",$J)
16 W !,"Building patient list for display..."
17 S IVMCTR=0
18 ;
19 ; - get patients with demographic fields from ASEG x-ref
20 S IVMI=0 F S IVMI=$O(^IVM(301.5,"ASEG","PID",IVMI)) Q:'IVMI D
21 .S IVMJ=0 F S IVMJ=$O(^IVM(301.5,"ASEG","PID",IVMI,IVMJ)) Q:'IVMJ D
22 ..S IVMCTR=IVMCTR+1 W:'(IVMCTR#15) "."
23 ..;
24 ..; - grab node from file #301.5
25 ..S IVM0NODE=$G(^IVM(301.5,IVMI,0)) I IVM0NODE']"" Q
26 ..;
27 ..; - get DFN and grab node from file #2
28 ..S DFN=+IVM0NODE,IVM0DPT=$G(^DPT(+DFN,0)) I IVM0DPT']"" Q
29 ..;
30 ..; - patient name and ssn
31 ..S IVMNAME=$P(IVM0DPT,"^"),IVMSSN=$P(IVM0DPT,"^",9),IVMSSN=$E(IVMSSN,1,3)_"-"_$E(IVMSSN,4,5)_"-"_$E(IVMSSN,6,9)
32 ..;
33 ..; - check for uploadable and non-uploadable fields
34 ..S IVMUP=$S($$DEMO^IVMLDEM5(IVMI,IVMJ,1)=1:"YES",1:"NO")
35 ..S IVMINFO=$S($$DEMO^IVMLDEM5(IVMI,IVMJ,0)=1:"YES",1:"NO")
36 ..;
37 ..; - build line for list manager display
38 ..D BUILDLN
39 ;
40 I IVMCTR=0 W !!,"There is no IVM demographic information to be uploaded at this time.",!,*7
41 ;
42BUILDQ ; - clean up variables
43 K DFN,IVM0NODE,IVM0DPT,IVMCHK,IVMI,IVMINFO,IVMJ,IVMNAME,IVMSSN,IVMUP
44 Q
45 ;
46 ;
47BUILDLN ; - build storage array with data for List Manager (called from BLD)
48 ;
49 S ^TMP("IVMDUPL",$J,IVMNAME,IVMI,IVMJ)=DFN_"^"_IVMNAME_"^"_IVMSSN_"^"_IVMUP_"^"_IVMINFO
50 ;
51 ; ^tmp("ivmdupl",$j,pat name, ivm ien, ivm sub ien)=dfn^patient name^patient ssn^demo uploadable^demo info only
52 Q
53 ;
54 ;
55HDR ; - header code for list manager display
56 S VALMHDR(1)="Patient Demographic Information" ; header line 1
57 S VALMHDR(2)=" Uploadable Non-uploadable" ; header line 2
58 Q
59 ;
60 ;
61INIT ; - init variables and list array
62 K ^TMP("IVMLST",$J)
63 S IVMBL="",$P(IVMBL," ",30)="",IVMCTR=0
64 S IVMNAME="" F S IVMNAME=$O(^TMP("IVMDUPL",$J,IVMNAME)) Q:IVMNAME']"" S IVMI="" D
65 .F S IVMI=$O(^TMP("IVMDUPL",$J,IVMNAME,IVMI)) Q:'IVMI S IVMJ="" D
66 ..F S IVMJ=$O(^TMP("IVMDUPL",$J,IVMNAME,IVMI,IVMJ)) Q:'IVMJ D
67 ...;
68 ...; - IVMLN as the line for the list manager display
69 ...S IVMLN=$G(^TMP("IVMDUPL",$J,IVMNAME,IVMI,IVMJ)) I IVMLN']"" Q
70 ...;
71 ...; - increment counter and write line
72 ...S IVMCTR=IVMCTR+1 D WRLN(IVMLN,IVMCTR)
73 ...;
74 ...; - build index record to use for processing as
75 ...; ^tmp("ivmlst",$j,"idx",ctr,ctr)=dfn^pat name^ien (#301.5) file^ien (#301.501) sub file
76 ...S ^TMP("IVMLST",$J,"IDX",IVMCTR,IVMCTR)=$P(IVMLN,"^",1)_"^"_IVMNAME_"^"_IVMI_"^"_IVMJ
77 ;
78 ; - list manager variable as number of lines in the list
79 S VALMCNT=IVMCTR
80 ;
81INITQ ; - clean up variables
82 K DFN,IVMBL,IVMCTR,IVMI,IVMJ,IVMLINE,IVMLN,IVMNAME,IVMNUM
83 Q
84 ;
85 ;
86WRLN(IVMLINE,IVMNUM) ; - write line out for list manager display
87 ;
88 ; Input: IVMLINE -- as line for display
89 ; dfn^pat name^pat ssn^uploadable (yes/no)^non-uploadable (yes/no)
90 ; IVMNUM -- as the line number
91 ; Output: None
92 ;
93 N IVMLN
94 S IVMLN=$E($P(IVMLINE,"^",2)_IVMBL,1,30)_" "_$E($P(IVMLINE,"^",3)_IVMBL,1,15)_" "_$E($P(IVMLINE,"^",4)_IVMBL,1,13)_" "_$P(IVMLINE,"^",5)
95 I $P(IVMLINE,"^",4)["YES" D CNTRL^VALM10(IVMNUM,55,3,IOINHI,IOINORM) ; highlight
96 S @VALMAR@(IVMNUM,0)=$E(IVMNUM_" ",1,5)_IVMLN
97 Q
98 ;
99 ;
100HELP ; - help code
101 S X="?" D DISP^XQORM1 W !!
102 Q
103 ;
104 ;
105EXIT ; - exit code
106 K ^TMP("IVMLST",$J),^TMP("IVMDUPL",$J)
107 Q
Note: See TracBrowser for help on using the repository browser.