source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCENIA1.m@ 1267

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

initial load of FOIAVistA 6/30/08 version

File size: 5.8 KB
Line 
1SCENIA1 ;ALB/SCK - INCOMPLETE ENCOUNTER ERROR DISPLAY PROTOCOLS ; 09 Oct 98 3:03 PM
2 ;;5.3;Scheduling;**66,154,323,378**;AUG 13, 1993
3 ;
4VE ; View Expanded Error
5 N SDHDR1,SDHDR2
6 S SDHDR1=VALMHDR(1)
7 S SDHDR2=VALMHDR(2)
8 S VALMBCK=""
9 D EN^SCENIB0
10 S VALMBCK="R"
11 Q
12 ;
13CE ; Entry point for getting corrective action for error and executing it.
14 ; Variables
15 ; SCXER - Ptr to 409.76
16 ; SCEN - Ptr to 409.75
17 ; SDXMT - Ptr to 409.73
18 ;
19 N SCXER,SCEN
20 ;;;; MOD
21 K ^TMP("SCENI COR",$J)
22 ;
23 D SELERM("O")
24 Q:'$D(SCXER)
25 ;
26 ;;;;; MOD
27 ;F I=1:1 S SCTEXT=$P($T(HDR+I),";;",2) Q:SCTEXT["$$END" D
28 ;. W !?2,SCTEXT
29 ;
30 S SCEN=0
31 S SDXMT=$G(^TMP("SCENI XMT",$J,0)) Q:'SDXMT
32 F S SCEN=$O(SCXER(SCEN)) Q:'SCEN D
33 . Q:'$D(^SD(409.75,SCEN,0))
34 . S SCCOR=$G(^SD(409.76,$P(^SD(409.75,SCEN,0),U,2),"COR"))
35 . I SCCOR="" D ERMSG(1) Q
36 .;;;;;; MOD
37 . Q:$D(^TMP("SCENI COR",$J,$P(SCCOR,"(")))
38 . W !!,$G(^SD(409.76,$P(^SD(409.75,SCEN,0),U,2),1))
39 . X SCCOR
40 . I 'RTN D ERMSG(2) ;;;Q
41 .;;;;; MOD
42 . S ^TMP("SCENI COR",$J,$P(SCCOR,"("))=""
43 ;
44 ; ** After correcting selected errors, fire off the validator and reflag
45 ; transmission entry
46 W !,"Performing Ambulatory Care Validation Checks..."
47 S RTN=$$VALIDATE^SCMSVUT2(SDXMT)
48 I RTN<0 D ERMSG(5) G CEQ
49 S RTN=$$SETRFLG(SDXMT)
50 I RTN<0 D ERMSG(3) G CEQ
51 ;
52 ;;;;; MOD
53 K ^TMP("SCENI COR",$J)
54CEQ Q
55 ;
56EDI() ; Entry point for ENCOUNTER INFORMATION corrective action
57 S SDOK=0
58 D EI^SCENIA2
59 Q SDOK
60 ;
61DEM1() ; Entry point for correction logic
62 S SDOK=0
63 D DEM
64 Q SDOK
65 ;
66DEM ; Entry point for the SCENI PATIENT DEMOGRAPHICS protocol
67 N DFN,SDXMT,RTN
68 ;
69 S DFN=$G(^TMP("SCENI DFN",$J,0)) Q:'DFN
70 S SDXMT=$G(^TMP("SCENI XMT",$J,0)) Q:'SDXMT
71 D FULL^VALM1
72 ;SD*5.3*323 add sensitive record warning if applicable
73 ;reference to DGRPU1 allowed in Integration Agreement 413
74 N DIC S DIC=2,DIC(0)="EM",X="`"_DFN D ^DIC I Y=-1 S SDOK=1 Q
75 D QUES^DGRPU1(DFN,"ADD3")
76 ;
77 I '$D(SDOK) D
78 . W !,"Performing Ambulatory Care Validation Checks..."
79 . S RTN=$$VALIDATE^SCMSVUT2(SDXMT)
80 . ;;; MOD
81 . I RTN<0 D ERMSG(5) Q ;G DEMQ
82 . S RTN=$$SETRFLG(SDXMT)
83 . I RTN<0 D ERMSG(3) Q ;G DEMQ
84 I $D(SDOK) S SDOK=1
85DEMQ Q
86 ;
87INTV() ; Entry point for correction logic for checkout errors
88 S SDOK=0
89 D CO
90 Q SDOK
91 ;
92CO ; Entry point for SCENI CHECKOUT INTERVIEW
93 N SDXMT,SCENFLG,SDOE,SDDT,SDOEND
94 K SCINF
95 ;SD*5.3*323 add sensitive record warning if applicable next 5 lines
96 N DFN
97 S DFN=$G(^TMP("SCENI DFN",$J,0)) Q:'DFN
98 S SDXMT=$G(^TMP("SCENI XMT",$J,0)) Q:'SDXMT
99 D FULL^VALM1
100 N DIC S DIC=2,DIC(0)="EM",X="`"_DFN D ^DIC I Y=-1 S SDOK=1 Q
101 S SCSTAT=$$OPENC^SCUTIE1(SDXMT,"SCINF")
102 I SCSTAT D G COQ
103 . D FULL^VALM1
104 . W !!,$CHAR(7),"This is a deleted encounter. Checkout information cannot be changed!"
105 . D PAUSE^VALM1
106 ;
107 S SDOE=$P(^SD(409.73,SDXMT,0),U,2)
108 S SDOEND=$G(^SCE(+SDOE,0))
109 S SDCOHDL="",SCENFLG=1,VALMBCK=""
110 ;
111 I $P(SDOEND,U,8)=2,$P(SDOEND,U,6)="" D ADDEDIT(SDOEND) I 1
112 E D EN^SDCO6
113 ;
114 S VALMBCK="R"
115 ;
116 I '$D(SDOK) D
117 . W !,"Performing Ambulatory Care Validation Checks..."
118 . S RTN=$$VALIDATE^SCMSVUT2(SDXMT)
119 . ;;; MOD
120 . I RTN<0 D ERMSG(5) Q ;G COQ
121 . S RTN=$$SETRFLG(SDXMT)
122 . I RTN<0 D ERMSG(3) Q ;G COQ
123 I $D(SDOK) S SDOK=1
124COQ ;
125 Q
126 ;
127ADDEDIT(SDOEND) ;this is to edit add/edits
128 N VAR
129 Q:'$P(SDOEND,U,5)
130 S VAR=$$INTV^PXAPI("ADDEDIT","SD","PIMS",$P(SDOEND,U,5),"",$P(SDOEND,U,2))
131 Q
132 ;
133LEDT() ;
134 S SDOK=0
135 D LE
136 Q SDOK
137 ;
138LE ; Entry point patient load edit.
139 N DFN,SDXMT
140 ;
141 S DFN=$G(^TMP("SCENI DFN",$J,0)) Q:'DFN
142 S SDXMT=$G(^TMP("SCENI XMT",$J,0)) Q:'SDXMT
143 S VALMBCK="",DGNEW=0
144 D FULL^VALM1
145 ;SD*5.3*323 add sensitive record warning if applicable
146 N DIC S DIC=2,DIC(0)="EM",X="`"_DFN D ^DIC I Y=-1 S SDOK=1 Q
147 D A1^DG10
148 I '$D(SDOK) D
149 . W !,"Performing Ambulatory Care Validation Checks."
150 . S RTN=$$VALIDATE^SCMSVUT2(SDXMT)
151 . ;;;;; MOD
152 . I RTN<0 D ERMSG(5) Q ;G LEQ
153 . S RTN=$$SETRFLG(SDXMT)
154 . I RTN<0 D ERMSG(3) Q ;G LEQ
155 I $D(SDOK) S SDOK=1
156LEQ ;
157 Q
158 ;
159REFLG() ; Entry point for reflag correction action
160 ;;;; MOD
161 ;S SDOK=0
162 ;D FLG
163 ;Q SDOK
164 Q 1
165 ;
166FLG ; Entry point for Reflag Transmission protocol
167 N SDXMT
168 ;
169 S SDXMT=$G(^TMP("SCENI XMT",$J,0)) Q:'SDXMT
170 W !,"Performing Ambulatory Care Validation Checks..."
171 S RTN=$$VALIDATE^SCMSVUT2(SDXMT)
172 I RTN<0 D ERMSG(5) G FLQ
173 S RTN=$$SETRFLG(SDXMT)
174 I RTN<0 D ERMSG(3) G FLQ
175 ;;;; MOD
176 ;I $D(SDOK) S SDOK=1
177FLQ Q
178 ;
179SETRFLG(SDXMT) ;
180 ; Input
181 ; SDXMT - Pointer to Transmission File, #409.73
182 ;
183 ; Output
184 ; -1 - There was a problem reflaging the transmission
185 ; 0 - No errors occured
186 ; 1 - The entry is already flagged for transmission
187 ;
188 S RESULT=-1
189 S STATUS=$P($G(^SD(409.73,SDXMT,0)),U,4)
190 I STATUS S RESULT=1
191 E D
192 . D XMITFLAG^SCDXFU01(SDXMT,0),STREEVNT^SCDXFU01(SDXMT,0)
193 . S RESULT=0
194 D INIT^SCENIA0
195 D RE^VALM4
196 Q RESULT
197 ;
198MSG(SDTEXT,SDEXMT) ;
199 W:SDTEXT]"" !!,SDTEXT,!
200 S DIR(0)="FAO",DIR("A")="Press ENTER to continue " D ^DIR K DIR
201 Q 1
202 ;
203SELERM(FLG) ; Select Multiple entries
204 N VALMY
205 ;
206 D FULL^VALM1
207 I $G(FLG)']"" S FLG="O"
208 D EN^VALM2(XQORNOD(0),FLG) S VALMI=0
209 I '$D(VALMY) S VALMBCK="R" Q
210 S SDN1=""
211 F S SDN1=$O(VALMY(SDN1)) Q:'SDN1 D
212 . S SCEPTR="",SCEPTR=$O(^TMP("SCENI ERR",$J,"DA",SDN1,SCEPTR))
213 . I SCEPTR>0 S SCXER(SCEPTR)=""
214 Q
215 ;
216ERMSG(MSGN) ;
217 D FULL^VALM1
218 S SCTEXT=$P($T(@MSGN),";;",2)
219 W $CHAR(7)
220 W !!?5,SCTEXT,!
221 S DIR(0)="FAO",DIR("A")="Press ENTER to continue " D ^DIR K DIR
222 S VALMBCK="R"
223 Q
224 ;
225EXIT ;
226 I $D(VALMBCK),VALMBCK="R" D REFRESH^VALM S VALMBCK=$P(VALMBCK,"R")_$P(VALMBCK,"R",2)
227 Q
228 ;
229HDR ;
230 ;;Selecting a range of errors to correct may result in one or
231 ;;more similar errors being removed from the display list after
232 ;;correction of the initial error.
233 ;;$$END
234 ;
2351 ;;No correction logic has been defined for this error.
2362 ;;Unable to execute Correction Logic.
2373 ;;There was a problem trying to flag this entry for retransmission.
2384 ;;This transmission entry is already flagged for transmission.
2395 ;;The validator encountered a problem with this transmission entry.
Note: See TracBrowser for help on using the repository browser.