close Warning: Can't use blame annotator: 
svn blame failed on WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQLED05.m: 'GenericSWIGWrapper' object has no attribute '_wrap'

source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQLED05.m@ 1464

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

initial load of WorldVistAEHR
File size: 4.4 KB
RevLine 
1VAQLED05 ;ALB/JFP,JRP - PDX, LOAD/EDIT DIFFERENCES,SCREEN;01MAR93
2 ;;1.5;PATIENT DATA EXCHANGE;**6**;NOV 17, 1993
3EP ; -- Main entry point
4 W !,"Please wait while differences are found..."
5EP1 D FLECHK^VAQUTL98,FLDCHK^VAQUTL98 ; -- Build table of excluded fields
6 S (VAQECNT,VALMCNT)=0
7 K ^TMP("VAQL2",$J),^TMP("VAQIDX",$J)
8 I $D(^TMP("VAQLD",$J)) D MSG
9 D:$D(XRTL) T0^%ZOSV ; -- Capacity start
10 D MAIN,MULT
11 I VAQECNT=0 D
12 .S X=$$SETSTR^VALM1(" ","",1,80) D TMP2
13 .S X=$$SETSTR^VALM1(" ** No differences found...","",1,80) D TMP2
14 D EXIT
15 S:$D(XRT0) XRTN=$T(+0) D:$D(XRT0) T1^%ZOSV ; -- Capacity stop
16 QUIT
17 ;
18MAIN ; -- Loops thru patient file looking for differences by field
19 S FLE=2,SEQ=0,(TYPE,FLD)=""
20 F S FLD=$O(^TMP("VAQTR",$J,"VALUE",FLE,FLD)) Q:FLD="" D
21 .I (FLE=2)&($D(FLD(FLD))) D KILL1 QUIT
22 .S PDXVALUE=$G(^TMP("VAQTR",$J,"VALUE",FLE,FLD,SEQ))
23 .I PDXVALUE="" D KILL QUIT
24 .S PTVALUE=$G(^TMP("VAQPT",$J,"VALUE",FLE,FLD,SEQ))
25 .I PDXVALUE=PTVALUE D KILL QUIT
26 .D DISP1,DISP2
27 QUIT
28 ;
29MULT ; -- Loop thru multiple associated with patient file
30 S FLE=2,FLD=.01,SEQ=0,TYPE="M"
31 F S FLE=$O(^TMP("VAQTR",$J,"VALUE",FLE)) Q:(FLE="") D M1
32 QUIT
33M1 I $D(FLE(FLE)) D KILL2 QUIT
34 D MLOAD,MULTDIF
35 QUIT
36 ;
37MLOAD ; -- Loads .01 field of multiple into an array for compare (patient)
38 K ^TMP("PTVALUE",$J)
39 S SEQ=""
40 F S SEQ=$O(^TMP("VAQPT",$J,"VALUE",FLE,FLD,SEQ)) Q:SEQ="" D
41 .S PTVALUE=$G(^TMP("VAQPT",$J,"VALUE",FLE,FLD,SEQ))
42 .S:PTVALUE'="" ^TMP("PTVALUE",$J,PTVALUE)=""
43 QUIT
44 ;
45MULTDIF ; -- Displays entries which do not match .01
46 S SEQ="",FLD=.01
47 F S SEQ=$O(^TMP("VAQTR",$J,"VALUE",FLE,FLD,SEQ)) Q:SEQ="" D
48 .S PDXVALUE=$G(^TMP("VAQTR",$J,"VALUE",FLE,FLD,SEQ))
49 .Q:PDXVALUE=""
50 .I $D(^TMP("PTVALUE",$J,PDXVALUE)) D KF QUIT
51 .D DISP1,DISP3,DISP4
52 S X=$$SETSTR^VALM1(" ","",1,80) D TMP
53 QUIT
54 ;
55DISP1 ; -- Display line 1
56 S VAQECNT=VAQECNT+1
57 S X=$$SETSTR^VALM1(VAQECNT,"",1,3)
58 S FLDNAME="("_$P($G(^DD(FLE,FLD,0)),U,1)_")"
59 S X=$$SETSTR^VALM1(FLDNAME,X,6,73)
60 D TMP
61 QUIT
62 ;
63DISP2 ; -- Display line 2
64 S X=$$SETFLD^VALM1($S(PTVALUE'="":PTVALUE,1:"* no data in patient file "),"","PTVALUE")
65 S X=$$SETFLD^VALM1($S(PDXVALUE'="":PDXVALUE,1:"* no data in PDX data file "),X,"PDXVALUE")
66 D TMP
67 S X=$$SETSTR^VALM1(" ","",1,80) D TMP
68 QUIT
69 ;
70DISP3 ; -- Display line 3
71 S X=$$SETFLD^VALM1("* multiple does not contain entry ","","PTVALUE")
72 S X=$$SETFLD^VALM1(PDXVALUE,X,"PDXVALUE")
73 D TMP
74 QUIT
75 ;
76DISP4 ; -- Displays all fields associated with multiple from transaction file
77 N FLD
78 S FLD=.01
79 F S FLD=$O(^TMP("VAQTR",$J,"VALUE",FLE,FLD)) Q:FLD="" D D41
80 QUIT
81D41 S PDXVALUE=$G(^TMP("VAQTR",$J,"VALUE",FLE,FLD,SEQ))
82 S FLDNAME=" - ("_$P($G(^DD(FLE,FLD,0)),U,1)_")"
83 S X=$$SETFLD^VALM1(FLDNAME,"","PTVALUE")
84 S X=$$SETFLD^VALM1($S(PDXVALUE'="":PDXVALUE,1:"* no data in PDX data file "),X,"PDXVALUE")
85 D TMP
86 QUIT
87 ;
88KILL ; -- Kills entries which are not different for work arrays
89 K ^TMP("VAQTR",$J,"VALUE",FLE,FLD,SEQ)
90 K ^TMP("VAQPT",$J,"VALUE",FLE,FLD,SEQ)
91 QUIT
92KILL1 K ^TMP("VAQTR",$J,"VALUE",FLE,FLD)
93 K ^TMP("VAQPT",$J,"VALUE",FLE,FLD)
94 QUIT
95KILL2 K ^TMP("VAQTR",$J,"VALUE",FLE)
96 K ^TMP("VAQPT",$J,"VALUE",FLE)
97 QUIT
98KF ; -- kills fields in subfile
99 N FLD S FLD=""
100 F S FLD=$O(^TMP("VAQTR",$J,"VALUE",FLE,FLD)) Q:FLD="" D KILL
101 QUIT
102 ;
103TMP ; -- Set the array used by list processor
104 S VALMCNT=VALMCNT+1
105 S ^TMP("VAQL2",$J,VALMCNT,0)=$E(X,1,79)
106 S ^TMP("VAQL2",$J,"IDX",VALMCNT,VAQECNT)=""
107 S:SEQ'="" ^TMP("VAQIDX",$J,VAQECNT)=DFNTR_"^"_DFNPT_"^"_FLE_"^"_FLD_"^"_SEQ_"^"_TYPE
108 Q
109MSG ; -- Displays entries not passing the input transform
110 N ENTRY,NODE,FLDNAME,MSG,LN,X
111 S X=$$SETSTR^VALM1(" ","",1,79) D TMP2
112 S ENTRY=""
113 F S ENTRY=$O(^TMP("VAQLD",$J,ENTRY)) Q:ENTRY="" D
114 .S NODE=$G(^TMP("VAQLD",$J,ENTRY))
115 .S FLDNAME=$P($G(^DD($P(NODE,U,1),$P(NODE,U,2),0)),U,1)
116 .S MSG="* Upload of "_FLDNAME_" did not pass input transform"
117 .S X=$$SETSTR^VALM1(MSG,"",1,79)
118 .D TMP2
119 S X=$$SETSTR^VALM1(" ","",1,79) D TMP2
120 S LN=$$REPEAT^VAQUTL1("-",79)
121 S X=$$SETSTR^VALM1(LN,"",1,79) D TMP2
122 S X=$$SETSTR^VALM1(" ","",1,79) D TMP2
123 K ENTRY,NODE,FLDNAME,MSG,LN,X
124 QUIT
125 ;
126TMP2 ; -- Sets array for list processor for message
127 S VALMCNT=VALMCNT+1
128 S ^TMP("VAQL2",$J,VALMCNT,0)=$E(X,1,79)
129 S ^TMP("VAQL2",$J,"IDX",VALMCNT,1)=""
130 QUIT
131 ;
132EXIT ; -- Note: The list processor cleans up its own variables.
133 ; All other variables cleaned up here.
134 K ^TMP("PTVALUE",$J)
135 K VAQECNT,FLE,FLD,SEQ,TYPE,PDXVALUE,PTVALUE,X,FLDNAME
136 Q
137 ;
138END ; -- End of code
139 QUIT
Note: See TracBrowser for help on using the repository browser.