source: FOIAVistA/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQLED02.m@ 794

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

initial load of FOIAVistA 6/30/08 version

File size: 3.7 KB
Line 
1VAQLED02 ;ALB/JFP - PDX, LOAD/EDIT,SETUP OF DIFFERENCES;01MAR93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3EP ; -- Main entry point for the list processor
4 ; -- K XQORS,VALMEVL ;(only kill on the first screen in)
5 ;
6 ;D CLEAR^VALM1
7 S VAQBCK=0
8 D MAIN^VAQLED04 ; -- collects PDX data and MAS data
9 I '$D(^TMP("VAQTR",$J))!('$D(^TMP("VAQPT",$J))) D QUIT
10 .W !," Error...No data collected"
11 .S VAQFLAG=1 D TRANEX
12 D EN^VALM("VAQ LED DIFFERENCES PDX6")
13 QUIT
14 ;
15INIT ; -- Builds array of differences between PDX minimal and the local
16 ; data stored in file 2.
17 ;
18 K ^TMP("VAQL2",$J)
19 K ^TMP("VAQPT",$J,"ID"),^TMP("VAQTR",$J,"ID"),^TMP("VAQLD",$J)
20 D EP^VAQLED05
21 QUIT
22 ;
23HD ; -- Make header line for list processor
24 D HD1^VAQEXT02 QUIT
25 ;
26FIELD ; -- Updates local patient file by field or fields selected
27 S (VAQFLAG,VAQUPDFL)=0
28 D SEL^VALM2
29 Q:'$D(VALMY)
30 D CLEAR^VALM1
31 S ENTRY="" K ^TMP("VAQLD",$J)
32 F S ENTRY=$O(VALMY(ENTRY)) Q:ENTRY="" D
33 .S SDAT=$G(^TMP("VAQIDX",$J,ENTRY))
34 .D UPDATE
35 I VAQUPDFL=1 D WORKLD
36 D EP1^VAQLED05 ; -- Redisplay
37 S VALMBCK="R"
38 S VAQBCK=1
39 QUIT
40 ;
41UPDATE ; -- Loads fields for update
42 S DFNTR=$P(SDAT,U,1)
43 S DFNPT=$P(SDAT,U,2)
44 I DFNPT="" W !,"Local patient pointer missing... unable to upload field" QUIT
45 S (FLE,LFLE)=$P(SDAT,U,3)
46 S FLD=$P(SDAT,U,4)
47 S SEQ=$P(SDAT,U,5)
48 S MFLAG=$P(SDAT,U,6)
49 I LFLE'=2 S LFLE=2 ; -- only lock top level file
50 S LOCKFLE=$G(^DIC(LFLE,0,"GL"))
51 L +(@(LOCKFLE_DFNPT_")")):60
52 I ('$T) W !,"Could not edit entry... record locked" K LOCKFLE QUIT
53 D:MFLAG="" UPDTER1
54 D:MFLAG="M" UPDTEM1
55 L -(@(LOCKFLE_DFNPT_")")) K LOCKFLE
56 ; -- data loaded
57 S VAQUPDFL=1
58 I '($D(Y)#2) D KILL QUIT
59 S ^TMP("VAQLD",$J,ENTRY)=FLE_"^"_FLD ; -- data not pass input transform
60 QUIT
61 ;
62UPDTER1 ; -- Updates patient with PDX data (field by field) ** NON MUTIPLE **
63 S DIE=$G(^DIC(FLE,0,"GL"))
64 S DA=DFNPT
65 S DR=FLD_"///^S X=$G(^TMP(""VAQTR"",$J,""VALUE"",FLE,FLD,0))"
66 D ^DIE
67 K DIE,DA,DR
68 QUIT
69 ;
70UPDTEM1 ; -- Updates patient with PDX data (field by field) ** MULTIPLE **
71 ; Loads pointer to main file
72 S MFLE=$G(^DD(FLE,0,"UP")) ; -- main file
73 S MFLD="",MFLD=$O(^DD(MFLE,"SB",FLE,MFLD))
74 S FLD=.01
75 S DIE=$G(^DIC(MFLE,0,"GL"))
76 S DA=DFNPT
77 S DR=MFLD_"///"_$G(^TMP("VAQTR",$J,"VALUE",FLE,FLD,SEQ))
78 D UPDTEM2
79 D ^DIE
80 K DIE,DA,DR,MFLE,MFLD,VALUE
81 QUIT
82 ;
83UPDTEM2 ; -- Load fields into sub file for entry
84 F S FLD=$O(^TMP("VAQTR",$J,"VALUE",FLE,FLD)) Q:FLD="" D
85 .S VALUE=FLD_"///"_$G(^TMP("VAQTR",$J,"VALUE",FLE,FLD,SEQ))
86 .S DR(2,FLE)=VALUE
87 .S DR(2,FLE,FLD)=VALUE
88 QUIT
89 ;
90LOAD ; -- Loads all different fields from PDX segment to local patient file
91 I '$D(^TMP("VAQIDX",$J)) S VALMBCK="Q" QUIT
92 S (VAQFLAG,VAQUPDFL)=0
93 D CLEAR^VALM1
94 S ENTRY="" K ^TMP("VAQLD",$J)
95 F S ENTRY=$O(^TMP("VAQIDX",$J,ENTRY)) Q:ENTRY="" D
96 .S SDAT=$G(^TMP("VAQIDX",$J,ENTRY))
97 .D UPDATE
98 I VAQUPDFL=1 D WORKLD
99 D EP1^VAQLED05
100 S VALMBCK="R"
101 S VAQBCK=1
102 QUIT
103 ;
104TRANEX ; -- Pauses screen
105 D PAUSE^VALM1
106 S:'$D(VAQFLAG) VAQFLAG=""
107 S VALMBCK=$S(VAQFLAG=0:"R",1:"Q")
108 QUIT
109 ;
110WORKLD ; -- Updates workload file for update
111 S X=$$WORKDONE^VAQADS01("UPDTE",DFNTR,$G(DUZ))
112 I X<0 W !,"Error updating workload file (UPDTE)... "_$P(X,U,2)
113 I $P($G(^VAT(394.61,DFNTR,0)),U,4)=0 QUIT
114 S X=$$WORKDONE^VAQADS01("SNSTVE",DFNTR,$G(DUZ))
115 I X<0 W !,"Error updating workload file (SNSTVE)... "_$P(X,U,2)
116 QUIT
117 ;
118KILL ; --
119 K ^TMP("VAQTR",$J,"VALUE",FLE,$S(MFLAG="M":.01,1:FLD),SEQ)
120 K ^TMP("VAQPT",$J,"VALUE",FLE,$S(MFLAG="M":.01,1:FLD),SEQ)
121 QUIT
122 ;
123EXIT ; -- Note: The list processor cleans up its own variables.
124 ; All other variables cleaned up here.
125 ;
126 K ^TMP("VAQL2",$J),^TMP("VAQIDX",$J)
127 K ^TMP("VAQPT",$J),^TMP("VAQTR",$J),^TMP("VAQLD",$J)
128 K VAQFLAG,VAQUPDFL
129 K DFNTR,DFNPT,FLE,FLD,SEQ,MFLAG,LFLE
130 Q
131 ;
132END ; -- End of code
133 QUIT
Note: See TracBrowser for help on using the repository browser.