source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDSCEDT.m@ 1446

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

initial load of FOIAVistA 6/30/08 version
File size: 9.4 KB
Line 
1SDSCEDT ;ALB/JAM/RBS - ASCD Review and Edit SC value for encounters. ; 4/24/07 4:29pm
2 ;;5.3;Scheduling;**495**;Aug 13, 1993;Build 50
3 ;;MODIFIED FOR NATIONAL RELEASE from a Class III software product
4 ;;known as Service Connected Automated Monitoring (SCAM).
5 ;
6 Q
7START ; Called by option "SDSC EDIT BY DATE - Edit encounters by date range"
8 N SCVST,SCOPT,SDSCEDIT S SDSCEDIT=1
9 D HOME^%ZIS
10 ; Ask which records should be reviewed.
11 S SCOPT=$$SCSEL^SDSCUTL() I SCOPT="" G END
12 ; Select correct user type based on security key.
13 D TYPE^SDSCUTL
14 ; Get start and end date for encounter list.
15 D GETDATE^SDSCOMP I SDSCTDT="" G END
16 D DIV^SDSCUTL
17 D ^DIR
18 I $G(DTOUT)!($G(DUOUT)) G END
19 S SDSCDVSL=Y,SDSCDVLN=SCLN
20 K DIR,X,Y,SCLN
21 S SDSCDIV=$S(SDSCDVSL'[SDSCDVLN:","_SDSCDVSL,1:"")
22 ; Initialize quit flags.
23 S SDQFLG=0,SDFLG=0
24 I SDSCTAT'="" D OPT
25 I SDSCTAT="" D S SDSCTAT=""
26 . S SDSCTAT="N" D OPT Q:SDQFLG=1
27 . S SDSCTAT="R" D OPT Q:SDQFLG=1
28 . Q
29 I SDFLG=0 D EN^DDIOL("No editable encounters found in the specified date range. ",,"!!?10") W *7
30 G END
31 ;
32OPT ; Loop through requested encounter status for specified date range, display each encounter, and allow edit.
33 S SDOEDT=SDSCTDT F S SDOEDT=$O(^SDSC(409.48,"C",SDSCTAT,SDOEDT)) Q:SDOEDT\1>SDEDT Q:(SDOEDT="")!(SDQFLG=1) D
34 . S SDOE=0 F S SDOE=$O(^SDSC(409.48,"C",SDSCTAT,SDOEDT,SDOE)) Q:'SDOE!(SDQFLG=1) D
35 .. ; Check review selection
36 .. S SDV0=$P($$GETOE^SDOE(SDOE),U,5) I SDV0="" Q
37 .. S SCVST=$$GET1^DIQ(9000010,SDV0_",",80001,"I")
38 .. I SCVST'=SCOPT,SCOPT'=2 Q
39 .. ; Initialize flag and do final editability checks on encounter.
40 .. S SDEFLG=0 D CHECK
41 .. ; If edit flag not set, quit. (Don't display error in this loop.)
42 .. I SDEFLG=0 Q
43 .. ; Check for sensitive patient
44 .. I $$SENS^SDSCUTL(SDPAT,0) Q
45 .. ; Display encounter.
46 .. D DISPLAY,DISPLAY1
47 .. ; IF quit flag set, quit.
48 .. I SDQFLG=1 Q
49 .. ;Check if data came from an ancillary package and okay to edit
50 .. I '$$ANCPKG^SDSCUTL(SDOE) S SDSCMSG="Cannot edit encounter." Q
51 .. ; Otherwise, edit encounter.
52 .. D EDIT
53 Q
54START1 ; Called by option "SDSC SINGLE EDIT - Edit single encounter"
55 N SDSCEDIT S SDSCEDIT=1
56 D HOME^%ZIS
57 D TYPE^SDSCUTL
58 ; Initialize quit flag.
59 S SDQFLG=0
60 F D Q:SDQFLG=1
61 . S DIC(0)="AEMNZ",DIC="^SDSC(409.48,"
62 . S DIC("A")="Select OUTPATIENT ENCOUNTER: "
63 . I SDSCCR]"" S DIC("S")=SDSCCR_",$P($G(^SCE(+Y,0)),""^"",6)="""""
64 . I SDSCCR="" S DIC("S")="I $P($G(^SCE(+Y,0)),""^"",6)="""""
65 . W !
66 . D ^DIC
67 . I +Y=-1!$D(DTOUT)!$D(DUOUT) S SDQFLG=1 Q
68 . S SDOE=+Y,SDOEDT=$P($G(^SDSC(409.48,SDOE,0)),U,7)
69 . ; Separate editing checks and display code for ListMan.
70 . ; Initialize flag and do final editability checks on encounter.
71 . S SDEFLG=0 D CHECK
72 . ; If edit flag not set, display error and quit.
73 . I SDEFLG=0 D EN^DDIOL("Cannot edit encounter# "_SDOE_". Missing data. ",,"!!?10") W *7 Q
74 . ; Check for sensitive patient
75 . I $$SENS^SDSCUTL(SDPAT,0) Q
76 . ; Display encounter.
77 . D DISPLAY,DISPLAY1
78 . ; If quit flag set, quit.
79 . I SDQFLG=1 Q
80 . I '$$ANCPKG^SDSCUTL(SDOE) D EN^DDIOL("Cannot edit encounter.") Q
81 . ; Otherwise, edit encounter.
82 . D EDIT
83 G END
84 ;
85CHECK ; Final editing checks for specified encounter.
86 ; Check division, if doesn't match, quit.
87 I $G(SDSCDIV)'="",(","_SDSCDIV_",")'[(","_$P(^SDSC(409.48,SDOE,0),U,12)_",") Q
88 ; Get encounter data. If no encounter data, quit.
89 S SDOEDAT=$$GETOE^SDOE(SDOE)
90 I SDOEDAT="" S SDSCMSG=" no encounter zero node" Q
91 ; Get patient IEN.
92 S SDPAT=$P(SDOEDAT,U,2)
93 ; Get visit file entry. If no visit, quit.
94 S SDV0=$P(SDOEDAT,U,5) I SDV0="" S SDSCMSG=" encounter missing visit number" Q
95 I $G(^AUPNVSIT(SDV0,0))="" S SDSCMSG=" no visit zero node" Q
96 ; Get current service connection value from visit.
97 S SDOSC=$$GET1^DIQ(9000010,SDV0_",",80001,"I")
98 ; Get package and source info from visit file. If missing, quit.
99 S SDSCPKG=$$GET1^DIQ(9000010,SDV0_",",81202,"E") I SDSCPKG="" S SDSCPKG="SCHEDULING"
100 S SDSCSRC=$$GET1^DIQ(9000010,SDV0_",",81203,"E") I SDSCSRC="" S SDSCSRC="AUTOMATED SC DESIGNATION"
101 ; Data checks successful. Set flags to allow edit to continue
102 S SDEFLG=1,SDFLG=1
103 Q
104DISPLAY ; Compile display for the specified encounter into a TMP global.
105 ; Clear scratch global and reset line counter.
106 K ^TMP("SDSCLST",$J) S SDLN=0
107 S SDTMP="Encounter "_SDOE
108 I SDOSC=1 S SDTMP=SDTMP_" is marked as service connected and may not be."
109 E S SDTMP=SDTMP_" is NOT marked as service connected."
110 D LINE(SDTMP)
111 D LINE(" ")
112 ; Display the date for the encounter.
113 D LINE("Date of Encounter: "_$$FMTE^XLFDT(SDOEDT,"5MZ"))
114 ; Display the clinic for the encounter.
115 S SDCLIN=$P(SDOEDAT,U,4),SDTMP="Location: "
116 I SDCLIN]"" S SDTMP=SDTMP_$P($G(^SC(SDCLIN,0)),U)
117 D LINE(SDTMP)
118 ; Display the primary provider for the visit.
119 S SDPRV=$P($G(^SDSC(409.48,SDOE,0)),U,8),SDTMP="Primary Provider: "
120 I SDPRV]"" S SDTMP=SDTMP_$$UP^XLFSTR($$NAME^XUSER(SDPRV))
121 D LINE(SDTMP)
122 ; Display the patient name and last 4 SSN.
123 S SDTMP="Patient: "
124 I SDPAT]"" D
125 . N DFN,VADM S DFN=SDPAT D DEM^VADPT
126 . S SDTMP=SDTMP_$E(VADM(1),1,25)_" ("_$E($P(VADM(2),U),6,9)_")"
127 . ; Add flag if patient is considered sensitive.
128 . I +$P($G(^DGSL(38.1,+SDPAT,0)),U,2) S SDTMP=SDTMP_" *SENSITIVE*"
129 D LINE(SDTMP)
130 ; Compile patient insurance information.
131 D INS
132 ; Review VBA/ICD9 SC response
133 D VBAICD
134 ; Compile all POVs for this visit.
135 D GETPDX^SDOERPC(.SDPDX,SDOE),POV2S
136 ; Compile all disabilities for this patient.
137 D DIS2S
138 Q
139DISPLAY1 ; Display the specified encounter.
140 W @IOF
141 S L=0
142 F SDLN=1:1 Q:'$D(^TMP("SDSCLST",$J,SDLN,0)) D Q:$G(SDQFLG)=1
143 . I L+3>IOSL D CONT^SDSCUTL S L=2 Q:$G(SDQFLG)=1
144 . W !,^TMP("SDSCLST",$J,SDLN,0)
145 . S L=L+1
146 . Q
147 W !
148 Q
149INS ; Compile patient means test and insurance information.
150 S SDCP=$$BIL^DGMTUB(SDPAT,SDOEDT)
151 D LINE(" ")
152 D LINE("Patient "_$S(SDCP=1:"is",1:"is not")_" copay eligible.")
153 S SDACT=+$$INSUR^IBBAPI(SDPAT,SDOEDT)
154 D LINE("Patient "_$S(SDACT=1:"is",1:"is not")_" insured.")
155 I 'SDACT Q
156 ; ICR#: 4419 (SUPPORTED) - look for Outpatient coverage
157 S SDCOV=$S($$INSUR^IBBAPI(SDPAT,SDOEDT,"O","",16)<1:0,1:1)
158 D LINE("Outpatient Coverage is "_$S(SDCOV:"",1:"not ")_"covered.")
159 Q
160POV2S ; Compile all POV entries for the specified visit.
161 D LINE(" "),LINE(" POVs/ICDs:")
162 S SDVPOV0=0 F S SDVPOV0=$O(^AUPNVPOV("AD",SDV0,SDVPOV0)) Q:'SDVPOV0 D
163 . S SDPOV=$P($G(^AUPNVPOV(SDVPOV0,0)),U)
164 . ; Added display if diagnosis is marked service connected (CIDC) - ALA 9/27/05
165 . S SDPOVSC=$P($G(^AUPNVPOV(SDVPOV0,800)),U)
166 . S SCDX=$$ICDDX^ICDCODE(SDPOV,+SDOEDAT)
167 . S SDPSC=$S(SDPDX=$P(SCDX,U):"*P* ",1:"")_$S(SDPOVSC=1:"*SC* ",1:"")
168 . S SDTMP=$J(SDPSC,15)_$P(SCDX,U,2)_" "
169 . S SDTMP=$E(SDTMP,1,23)_$P(SCDX,U,4)
170 . D LINE(SDTMP)
171 Q
172DIS2S ; Compile all rated disabilities for this patient.
173 ;DBIA4807 and DBIA1476
174 D LINE(" ")
175 D LINE(" Rated Disabilities:")
176 N SCRD,I,I1,I2
177 D RDIS^DGRPDB(SDPAT,.SCRD)
178 S I=0 F S I=$O(SCRD(I)) Q:'I D
179 . S I1=SCRD(I)
180 . S I2=$S($D(^DIC(31,+I1,0)):$P(^(0),U,3)_" "_$P(^(0),"^",1)_" ("_+$P(I1,"^",2)_"%-"_$S($P(I1,"^",3):"SC",$P(I1,"^",3)']"":"not specified",1:"NSC")_")",1:"")
181 . D LINE(" "_I2)
182 Q
183VBAICD ;ASCD (VBA/ICD9) SC evaluation
184 N Y,VAL
185 D LINE(" ")
186 S Y=$$SC^SDSCAPI(SDPAT,,SDOE)
187 D LINE("ASCD Evaluation: "_$P(Y,"^",2))
188 Q
189LINE(LINE) ; Save a line of text into the scratch global.
190 S SDLN=SDLN+1,^TMP("SDSCLST",$J,SDLN,0)=LINE
191 Q
192EDIT ; Allow user to edit the specified encounter or send for review. (Roll and scroll)
193 K DIR,X,Y
194 S DIR(0)=SDOPT
195 S DIR("A")="DO YOU WANT TO CHANGE THE SERVICE CONNECTION FOR THIS ENCOUNTER? "
196 S DIR("?")=" "
197 S DIR("?",1)="Enter:"
198 S DIR("?",2)=" 'YES' to modify this encounter's Service Connected statuses."
199 S DIR("?",3)=" 'NO' to retain this encounter's Service Connected statuses."
200 S DIR("?",4)=" 'SKIP' to skip this encounter and review it later."
201 I SDOPT["REVIEW" S DIR("?",5)=" 'REVIEW' to flag this encounter for clinical review."
202 D ^DIR
203 I $D(DTOUT)!$D(DUOUT) S SDQFLG=1 Q
204 S SDANS=Y K DIR,X,Y
205LEDT ; ListMan Entry Point for Editing
206 ; If user selected 'SKIP', postpone action on this entry.
207 I $G(SDANS)="S" Q
208 ; Set 'REVIEW' flag if required.
209 S SDRFLG=$S(SDANS="R":1,1:0)
210 ; Lock record before editing
211 I '$$LOCK^SDSCUTL(SDOE) D Q
212 . W !!,"*** Encounter ",SDOE," locked by another user. Try later. ***" H 2
213 ; If user answered 'YES' then send call PCE API.
214 I SDANS="Y" D
215 . N SDEDIT S SDEDIT=1
216 . S X=$$INTV^PXAPI("POV",SDSCPKG,SDSCSRC,SDV0) HANG 1
217 I '$D(^SDSC(409.48,SDOE)) D G CTUP ;Entry deleted because of review match
218 . W !!,"*** Encounter ",SDOE," Removed from ASCD File - True Match Found ***" H 2
219 S SDSCC=$$GET1^DIQ(9000010,SDV0_",",80001,"I")
220 I SDSCC="",$D(^SDSC(409.48,SDOE)) D G CTUP ;Remove entry if no SC value
221 . N DA,DIK S DA=SDOE,DIK="^SDSC(409.48," D ^DIK
222 . W !!,"*** Encounter ",SDOE," Removed from ASCD File - No SC value found in Visit File ***" H 2
223 ; Store any changes the user made in the TRACK EDITS multiple.
224 D STEDT^SDSCUTL(SDOE,SDTYPE,SDRFLG,SDSCC)
225CTUP ; Update claims tracking file in IB.
226 D
227 . I '$D(^SDSC(409.48,SDOE)) N SCTUPD S SCTUPD=$$RNBU^IBRSUTL(SDOE,1) Q
228 . D CLM^SDSCCLM(SDOE)
229 D UNLOCK^SDSCUTL(SDOE)
230 Q
231 ;
232END ; Clear all variables before exiting.
233 K SDSCTDT,SDEDT,SDOEDT,SDOE,SDOEX,SDEC,SDPAT,SDPASS,SDICD,SDPOV,SDSCC
234 K SDCST,SDSCPKG,SDSCSRC,SDPOVSC,SDPSC,SCDX,SDSCDVSL,SDFILEOK,SDV0
235 K SDVPOV0,SDPD,SDIENS,DA,DIE,DIC,DLAYGO,DIERR,ERR,SDRFLG,SDQFLG,SDTYPE
236 K SDOPT,SDSCTAT,SDSCDIV,SDSCDVLN,SDSCMSG,SDPRV,SDCLIN,SDLIST,P,L,SDABRT
237 K X,X1,X2,Y,DTOUT,DUOUT,DIR,SDACT,SDCOV,SDSCCR,SDOEDAT,SDEFLG,SDOSC,SDCP
238 K SDFLG,SDLN,SDTMP,SDANS,SDSCBDT,SDSCEDT,SDCNT,SDDATA,SDPDX
239 D KVA^VADPT
240 Q
Note: See TracBrowser for help on using the repository browser.