source: FOIAVistA/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMLDEM2.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1IVMLDEM2 ;ALB/KCL - IVM DEMOGRAPHIC UPLOADABLE FIELDS ; 15-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 for IVM DEMOGRAPHIC UPLOADABLE
7 N IVMENT
8 D EN^VALM("IVM DEMOGRAPHIC UPLOADABLE")
9 Q
10 ;
11 ;
12HDR ; - header code for list manager display
13 S IVMBLNK="",$P(IVMBLNK," ",45)=""
14 ;
15 ; - list manager header line 1
16 S VALMHDR(1)="Patient: "_$E($E($P(^DPT(DFN,0),"^"),1,20)_" "_"("_$E($P(^DPT(DFN,0),"^",9),6,9)_")"_IVMBLNK,1,39)_" "_"Uploadable Demographic Fields"
17 ;
18 ; - list manager header line 2
19 S VALMHDR(2)=" "
20 Q
21 ;
22 ;
23INIT ; - init variables and list array
24 ;
25 ; Input: IVMDA2 -- Pointer to case record in file #301.5
26 ; IVMDA1 -- Pointer to PID msg in sub-file #301.501
27 ; DFN -- Pointer to patient in file #2
28 ;
29 ;
30 ; - flag used for delete demographic field action (DF)
31 S IVMWHERE="UP"
32 ;
33 K ^TMP("IVMUPLOAD",$J)
34 S IVMBL="",$P(IVMBL," ",35)="",IVMCNTR=0
35 D DEM^VADPT,ADD^VADPT S IVMSTATE="",IVMSTPTR=$P(VAPA(5),"^")
36 F IVMDA=0:0 S IVMDA=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA)) Q:'IVMDA D
37 .;
38 .; - grab node with IVM-supplied data
39 .S IVMDEMO=$G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA,0)) I IVMDEMO="" Q
40 .;
41 .; - quit if data element is non-uploadable
42 .S IVMTABLE=$G(^IVM(301.92,+$P(IVMDEMO,"^"),0))
43 .Q:'$P(IVMTABLE,"^",3)
44 .;
45 .; - grab the IVM-supplied state
46 .I $P(IVMTABLE,"^",2)["PID114" S IVMSTATE=$P(IVMDEMO,"^",2)
47 .;
48 .S IVMCNTR=IVMCNTR+1
49 .;
50 .; - extract DHCP value in displayable format
51 .S IVMDHCP="" X:$D(^IVM(301.92,+$P(IVMDEMO,"^"),2)) ^(2) S IVMDHCP=Y
52 .;
53 .; - build index record to use for processing as
54 .; ^tmp("ivmupload",$j,"idx",ctr,ctr)=dfn^da(2)^da(1)^da^ivm data^pointer to file (#1)^dhcp field number^dhcp field name
55 .;
56 .S ^TMP("IVMUPLOAD",$J,"IDX",IVMCNTR,IVMCNTR)=DFN_"^"_IVMDA2_"^"_IVMDA1_"^"_IVMDA_"^"_$P(IVMDEMO,"^",2)_"^"_$P(IVMTABLE,"^",4)_"^"_$P(IVMTABLE,"^",5)_"^"_$P(IVMTABLE,"^")
57 .;
58 .; - build list manager display line
59 .D WRITLINE($P(IVMTABLE,"^")_"^"_IVMDHCP_"^"_$P(IVMDEMO,"^",2),IVMCNTR)
60 ;
61 ;I '$O(@VALMAR@(0)) S @VALMAR@(1,0)=" ",@VALMAR@(2,0)="There is no uploadable demographic information to view.",IVMCNTR=2,^TMP("IVMUPLOAD",$J,"IDX",1,1)=1,^TMP("IVMUPLOAD",$J,"IDX",2,2)=2
62 ;
63 ;
64 I '$O(@VALMAR@(0)) D
65 .;
66 .; - check for non-uploadable fields, if no fields do DELETE
67 .I '$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,0) D DELETE^IVMLDEM5(IVMDA2,IVMDA1,IVMNAME)
68 .;
69 .; - if non-uploadable fields set array field from 'YES' to 'NO' for list manager display
70 .I $$DEMO^IVMLDEM5(IVMDA2,IVMDA1,0) S $P(^TMP("IVMDUPL",$J,IVMNAME,IVMDA2,IVMDA1),"^",4)="NO"
71 .;
72 .; - display msg to user that no uploadable data to view
73 .S @VALMAR@(1,0)=" "
74 .S @VALMAR@(2,0)="There is no uploadable demographic information to view."
75 .S IVMCNTR=2
76 ;
77 ; - list manager variable as number of lines in the list
78 S VALMCNT=IVMCNTR
79 ;
80INITQ ; - clean up variables
81 D KVA^VADPT ; kill all variables defined by VADPT routine
82 K IVMBL,IVMBLNK,IVMCNTR,IVMDA,IVMDEMO,IVMDHCP,IVMFIELD,IVMSTATE,IVMSTPTR,IVMTABLE
83 Q
84 ;
85 ;
86WRITLINE(IVMLINE,IVMNUM) ; - write line out for list manager display
87 ;
88 ; Input: IVMLINE -- as the line for display:
89 ; dhcp field name^dhcp field value^ivm field value
90 ; IVMNUM -- as the line number
91 ; Output: None
92 ;
93 N IVMLN,IVMOUT1,IVMOUT2
94 S IVMOUT1=$P(IVMLINE,"^",2)
95 I $P(IVMTABLE,"^",7) S IVMOUT1=$$OUTTR^IVMUFNC(IVMOUT1,IVMTABLE,IVMSTPTR)
96 S:IVMOUT1="" IVMOUT1="(* NONE ON FILE *)"
97 S IVMOUT2=$$OUTTR^IVMUFNC($P(IVMLINE,"^",3),IVMTABLE,IVMSTATE)
98 S IVMLN=$E($P(IVMLINE,"^",1)_IVMBL,1,30)_" "_$E(IVMOUT1_IVMBL,1,20)_" "_$E(IVMOUT2_IVMBL,1,20)
99 D CNTRL^VALM10(IVMNUM,58,22,IOINHI,IOINORM) ; highlight IVM field value
100 S @VALMAR@(IVMNUM,0)=$E(IVMNUM_" ",1,3)_IVMLN
101 Q
102 ;
103 ;
104HELP ; - help code
105 S X="?" D DISP^XQORM1 W !!
106 Q
107 ;
108EXIT ; - exit code
109 K ^TMP("IVMUPLOAD",$J)
110 Q
Note: See TracBrowser for help on using the repository browser.