source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCENI0.m@ 1800

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

initial load of FOIAVistA 6/30/08 version
File size: 6.9 KB
Line 
1SCENI0 ;ALB/SCK - INCOMPLETE ENCOUNTER MGMT MAIN LM DISPLAY ; 07-MAY-1997
2 ;;5.3;Scheduling;**66**;AUG 13, 1993
3 ;
4EN ; Entry point for IEMM LM display
5 ; Variables
6 ; VAUTC,VAUTD - Clinic and Division o/m/a arrays
7 ; SDENTYP - Search type, P:patient, C:Clinic, E:Error Code
8 ; SDCLN - Clinic from selection lookup
9 ; SDDT - Date range for search, Begin^End format
10 ; SDY - Local variable used in selection criteria
11 ; SDEVAL - Error code value
12 ; SDFN - Patient DFN for local use
13 ; SDIEMM - Flag for IEMM
14 ;
15 N SDENTYP,DFN,SDCLN,SDDT,VAUTC,VAUTD,SDY,SDEVAL,SDFN,SDIEMM
16 K X,SDB,XQORNOD,DA,DR,DIE,%B
17 ;
18AGN Q:'$$ENTRY^SCUTIE2(.SDY)
19 I $G(SDENTYP)']"" G AGN
20 ;
21 I SDENTYP["P" D
22 . S SDFN=+SDY
23 . S VAUTC=1
24 . S X=$P($G(^DG(43,1,"SCLR")),U,12)
25 . S SDDT=$$FMADD^XLFDT($$DT^XLFDT,-X)_U_$$DT^XLFDT
26 ;
27 I SDENTYP["C" D G:'$$ASKDT^SCENI01(.SDDT) ENQ
28 . S SDCLN=+SDY
29 . S VAUTC=0,VAUTC(+SDY)=$P(^SC(+SDY,0),U)
30 ;
31 I SDENTYP["E" D G:'$$ASKDT^SCENI01(.SDDT) ENQ
32 . S VAUTC=1
33 . S SDEVAL=+SDY
34 ;
35 S VAUTD=1
36EN1 D WAIT^DICD
37 I $G(FLG1) K XQORS,VALMEVL
38 S SDIEMM=1
39 D EN^VALM("SCENI INCOMPLETE ENC MGT")
40ENQ Q
41 ;
42ENP(SDXPTR) ; Entry point for Data validation, Patient Predefined
43 ; This entry point will jump to the second LM screen and display any
44 ; errors for the encounter.
45 ;
46 ; Input
47 ; SDXMT - Pointer to transmission file, 409.73
48 ;
49 ; Variables
50 ; FLG1 - Flag for patient defined entry point
51 ;
52 N FLG1,SDIEMM
53 S SDIEMM=1
54 ;S VALMBCK="R"
55 S FLG1=1
56 D EN^SCENIA0
57 Q
58 ;
59HDR ; -- header code
60 N SDCLN
61 ;
62 S VALMHDR(1)="Date Range: "_$$FDATE^VALM1($P(SDDT,U))_" thru "_$$FDATE^VALM1($P(SDDT,U,2))
63 ;
64 I SDENTYP["P" D
65 . S VALMHDR(2)=" Patient: "_$P(^DPT(SDFN,0),U)
66 I SDENTYP["C" D
67 . S SDCLN=$O(VAUTC(0))
68 . S VALMHDR(2)=" Clinic: "_$E(VAUTC(SDCLN),1,25)
69 I SDENTYP["E" D
70 . S VALMHDR(2)="Error Code: "_$E($P(^SD(409.76,SDEVAL,1),U),1,60)
71 S VALMSG="'*' Deleted Encounter Enter ?? for more actions"
72 Q
73 ;
74INIT ; -- init variables and list array
75 N SDCNT
76 ;
77 K XQORNOD
78 K ^TMP("SCENI",$J) ; Sorting global
79 K ^TMP("SCEN LM",$J) ; LM Display global
80 K ^TMP("SCENIDX",$J) ; Index for expand encounter
81 D CLEAN^VALM10
82 ;
83 S BL="",$P(BL," ",30)=""
84 S X=VALMDDF("INDEX"),IC=$P(X,U,2),IW=$P(X,U,3)
85 S X=VALMDDF("ENCOUNTER"),EC=$P(X,U,2),EW=$P(X,U,3)
86 S X=VALMDDF("SSN"),SC=$P(X,U,2),SW=$P(X,U,3)
87 S X=VALMDDF("PATIENT"),PC=$P(X,U,2),PW=$P(X,U,3)
88 S X=VALMDDF("DELETED"),DC=$P(X,U,2),DW=$P(X,U,3)
89 ;
90 D BLD,BLDLM
91 I '$D(^TMP("SCENI",$J)) D
92 . S (SDCNT,VALMCNT)=0
93 . D SET(" "),SET(" No Incomplete Encounters found.")
94 Q
95 ;
96BLD ; Order through the Xmited OE Error file on encounter Xref
97 ; Variables
98 ; SDOEDT - Encounter date
99 ; SDOE - Pointer to #409.68
100 ; SDE - End date of date range
101 ; SDCNT - Count of entries
102 ; SDXMT - Pointer to #409.73
103 ; SDXER - Pointer to #409.75
104 ;
105 N SDOEDT,SDOE,SDE,SDCNT,SDXMT,SDXER
106 ;
107 Q:'$D(SDDT)
108 S SDOEDT=$P(SDDT,U)-.1,SDE=$P(SDDT,U,2)+.9,(SDCNT,VALMCNT)=0
109 I SDENTYP["P" D PLKUP(SDFN) Q
110 I SDENTYP["C" D CLKUP($O(VAUTC(0))) Q
111 ;the remaining is for a error code look up
112 F S SDOEDT=$O(^SD(409.75,"AEDT",SDOEDT)) Q:'SDOEDT!(SDOEDT>SDE) D
113 . S SDXMT=0 F S SDXMT=$O(^SD(409.75,"AEDT",SDOEDT,SDXMT)) Q:'SDXMT D
114 .. S SDXER=0 F S SDXER=$O(^SD(409.75,"AEDT",SDOEDT,SDXMT,SDXER)) Q:'SDXER I $D(^SD(409.75,SDXER,0)) D:$P(^SD(409.75,SDXER,0),U,2)=SDEVAL BLDA(SDXMT,SDOEDT)
115 Q
116 ;
117BLDA(SDXMT,SDOEDT) ; Build list entry, and retreive encounter information
118 ; Input
119 ; SDXMT - Pointer to $409.73
120 ; SDOEDT - Date of encounter
121 ;
122 ; Out
123 ; ^TMP("SCEN LM",$J,Patient Name,Encounter Date,Xmt Ptr)=DFN^BID^Delete marker ('*')
124 ;
125 N DFN
126 ;
127 Q:'SDOEDT
128 S SDCNT=SDCNT+1,SDDEL=""
129 S SCSTAT=$$OPENC^SCUTIE1(SDXMT,"SCINF")
130 ;
131 S:SCSTAT=1 SDDEL="*"
132 I SCSTAT<0 Q
133 ;
134 S SDNAME=$$LOWER^VALM1($P(^DPT(SCINF("DFN"),0),U))
135 S DFN=SCINF("DFN")
136 D PID^VADPT6
137 S ^TMP("SCEN LM",$J,SDNAME,SDOEDT,SDXMT)=SCINF("DFN")_U_VA("BID")_U_$G(SDDEL)
138 K SDDEL
139 Q
140 ;
141BLDLM ; Build display list array for LM
142 ; Variables
143 ; SDN - Patient Name
144 ; SDD - Encounter Date
145 ; SDXT - Pointer to #409.73, transmission pointer
146 ;
147 S SDCNT=0
148 S SDN="" F S SDN=$O(^TMP("SCEN LM",$J,SDN)) Q:SDN']"" D
149 . S SDD="" F S SDD=$O(^TMP("SCEN LM",$J,SDN,SDD)) Q:'SDD D
150 .. S SDXT="" F S SDXT=$O(^TMP("SCEN LM",$J,SDN,SDD,SDXT)) Q:'SDXT D BLDLM1(SDXT)
151 Q
152 ;
153BLDLM1(SDXT) ; Build LM Display line
154 ; Input
155 ; SDXT - DFN^BID^Delete marker ('*')
156 ;
157 K SDX
158 S SDCNT=SDCNT+1,SDX="",$P(SDX," ",VALMWD+1)=""
159 S SDX=$E(SDX,1,IC-1)_$E(SDCNT_BL,1,IW)_$E(SDX,IC+IW+1,VALMWD)
160 S SDX=$E(SDX,1,DC-1)_$E($P(^TMP("SCEN LM",$J,SDN,SDD,SDXT),U,3)_BL,1,DW)_$E(SDX,DC+DW+1,VALMWD)
161 S SDX=$E(SDX,1,PC-1)_$E(SDN_BL,1,PW)_$E(SDX,PC+PW+1,VALMWD)
162 S SDX=$E(SDX,1,SC-1)_$E($P(^TMP("SCEN LM",$J,SDN,SDD,SDXT),U,2)_BL,1,SW)_$E(SDX,SC+SW+1,VALMWD)
163 S SDX=$E(SDX,1,EC-1)_$E($$FMTE^XLFDT(SDD,1)_BL,1,EW)_$E(SDX,EC+EW+1,VALMWD)
164 D SET(SDX,SDXT)
165 Q
166 ;
167SET(X,SDXMT) ;
168 N SCEN
169 ;
170 S VALMCNT=VALMCNT+1,^TMP("SCENI",$J,VALMCNT,0)=X
171 Q:'SDCNT
172 S ^TMP("SCENI",$J,"IDX",VALMCNT,SDCNT)=""
173 S ^TMP("SCENI",$J,SDCNT,0)=X
174 S ^TMP("SCENI",$J,"XMT",SDCNT,SDXMT)=""
175 ;
176 I $$OPENC^SCUTIE1(SDXMT,"SCEN")>-1 D
177 . S ^TMP("SCENIDX",$J,SDCNT)=VALMCNT_U_SCEN("DFN")_U_SCEN("ENCOUNTER")_U_SCEN("CLINIC")
178 Q
179 ;
180HELP ; -- help code
181 S X="?" D DISP^XQORM1 W !!
182 Q
183 ;
184EXIT ; -- exit code
185 I $D(VALMBCK),VALMBCK="R" D REFRESH^VALM S VALMBCK=$P(VALMBCK,"R")_$P(VALMBCK,"R",2) G EX1
186 K ^TMP("SCENI",$J),^TMP("SCEN LM",$J),^TMP("SCENIDX",$J),^TMP("SCENI TMP",$J)
187 I '$G(FLG1) K ^TMP("SDAMIDX",$J)
188 K VA,SDCLN,SDIV,SDENDDT1,SDNR,SDPRDIV,ANS,DFN,EC,EW,IC,IW,PC,PW,SC,SW,SDX,DC,DW,SDNAME,SDFN,VAUTINI,SDCNT,DIC,BL
189 K SDOK,SCINF,RTN,SCSTAT,SCEN,RESULT,SCTEXT,LINE,SDDEL,SDD,SDN,SDXT,SDBDT,SDCL,SDDA,SDOEDT,SDOEL,SDVIEN,SDXMT
190 K VALMDDF
191 D FULL^VALM1
192 D CLEAN^VALM10
193EX1 Q
194 ;
195PLKUP(SDFN) ;
196 ;This is the lookup by patient.
197 ;SDFN is the DFN of the patient.
198 ;
199 N COD,SDXER
200 S COD=""
201 F S COD=$O(^SD(409.75,"ACOD",SDFN,COD)) Q:COD="" S SDXER=0 F S SDXER=$O(^SD(409.75,"ACOD",SDFN,COD,SDXER)) Q:SDXER="" DO
202 .N NODE,ANS
203 .S NODE=$G(^SD(409.75,SDXER,0)) I NODE=""!($P(NODE,U,1)'>0) Q
204 .S ANS=$$CHKDATE($P(NODE,U,1),SDOEDT,SDE)
205 .I ANS D BLDA($P(NODE,U,1),$P(ANS,U,2))
206 .Q
207 Q
208 ;
209CLKUP(SDCLN) ;
210 ;
211 ;This is the lookup by clinic.
212 ;SDCLN is the IEN of the clinic
213 ;
214 N SDXER,XMIT,ANS
215 S SDXER=0
216 F S SDXER=$O(^SD(409.75,"AECL",SDCLN,SDXER)) Q:SDXER="" S XMIT=$P($G(^SD(409.75,SDXER,0)),U,1) I XMIT]"" S ANS=$$CHKDATE(XMIT,SDOEDT,SDE) I ANS D BLDA(XMIT,$P(ANS,U,2))
217 Q
218 ;
219CHKDATE(XMIT,BDT,EDT) ;
220 ;this function call ensures that the date of the encounter is within
221 ;the parameters.
222 ;
223 ;XMIT - IEN of 409.73
224 ;BDT - the beginning date
225 ;EDT - the ending date
226 ;
227 N ANS
228 S XMIT=$G(^SD(409.73,XMIT,0))
229 I XMIT="" S ANS=0 G CHKQ
230 I $P(XMIT,U,2)]"" S DATE=$P($G(^SCE($P(XMIT,U,2),0)),U,1)
231 I $P(XMIT,U,3)]"" S DATE=$P($G(^SD(409.74,$P(XMIT,U,3),0)),U,1)
232 I (DATE<BDT)!(DATE>EDT) S ANS=0
233 E S ANS="1^"_DATE
234CHKQ Q ANS
Note: See TracBrowser for help on using the repository browser.