source: FOIAVistA/trunk/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEX03.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 8.7 KB
Line 
1RGEX03 ;BAY/ALS-LIST MANAGER FOR MPI/PD EXCEPTIONS ;10/13/99
2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**3,12,19,23,27,30,38,39,43,44,48**;30 Apr 99;Build 3
3 ;
4 ;Reference to START^VAFCPDAT supported by IA #3299
5 ;Reference to ^DIA(2 supported by IA #2097
6 ;Reference to ^DPT( supported by IA #2969
7 ;Reference to HINQ^DG10 supported by IA #2076
8 ;Reference to CIRNEXC^MPIFQ0 supported by IA #2942
9 ;Reference to VTQ^MPIFSAQ supported by IA #2941
10 ;Reference to NOTICE^DGSEC4 and PTSEC^DGSEC4 supported by IA#3027
11 ;Reference to POT^MPIFDUP supported by IA #4464
12 ;
13EN(DATA) ; -- main entry point for RG EXCPT ACTION
14 D EN^VALM("RG EXCPT ACTION")
15 Q
16HDR ; -- header code
17 S VALMHDR(1)="MPI/PD EXCEPTION HANDLING ACTIONS.",VALMHDR(2)=""
18 Q
19INIT ; -- init variables and list array
20 K ^TMP("RGEXC2",$J)
21 K @VALMAR
22 I DATA="" Q
23 S STR="",LIN=1,STATUS="",NAME="",DOB="",SSN="",DFN="",CHKSM="" ;**44
24 S NAME=$P(DATA,"^",1),DOB=$P(DATA,"^",8),SSN=$P(DATA,"^",2)
25 S DFN=$P(DATA,"^",5),CHKSM=$P($G(^DPT(DFN,"MPI")),"^",2) ;**44
26 S STR=$$SETSTR^VALM1("Name:",STR,6,6),STR=$$SETSTR^VALM1(NAME,STR,14,30) D ADDTMP
27 S STR=$$SETSTR^VALM1(" SSN:",STR,6,6),STR=$$SETSTR^VALM1(SSN,STR,14,12) D ADDTMP
28 S STR=$$SETSTR^VALM1(" DOB:",STR,6,6),STR=$$SETSTR^VALM1(DOB,STR,14,20) D ADDTMP
29 S STR=$$SETSTR^VALM1(" DFN:",STR,6,6),STR=$$SETSTR^VALM1(DFN,STR,14,12) D ADDTMP ;**44
30 S STR=$$SETSTR^VALM1(" ICN:",STR,6,6),ICN="" S ICN=$P(DATA,"^",6) I ICN<0 S ICN=""
31 S STR=$$SETSTR^VALM1(ICN_($S(CHKSM="":"",1:"V"_CHKSM)),STR,14,20) D ADDTMP ;**44
32 S STR=$$SETSTR^VALM1("Date of Death:",STR,6,20),STR=$$SETSTR^VALM1($P(DATA,"^",13),STR,26,20) D ADDTMP
33 S STR=$$SETSTR^VALM1("Exception Type:",STR,6,20),STR=$$SETSTR^VALM1($P(DATA,"^",4),STR,26,50) D ADDTMP
34 S STR=$$SETSTR^VALM1("Exception Date:",STR,6,20),STR=$$SETSTR^VALM1($P(DATA,"^",3),STR,26,30) D ADDTMP
35 S STATUS=$P(DATA,"^",9)
36 I STATUS<1 S STATUS="NOT PROCESSED"
37 E S STATUS="PROCESSED"
38 S STR=$$SETSTR^VALM1("Exception Status:",STR,6,20),STR=$$SETSTR^VALM1(STATUS,STR,26,15) D ADDTMP
39 ;Added Exception Text to Exception Handler, patch 39
40 N IEN,IEN2,X K ^UTILITY($J,"W") S IEN=$P(DATA,"^",10),IEN2=$P(DATA,"^",11)
41 I IEN'=""!(IEN2'="") D
42 .S EXCTEXT=$P($G(^RGHL7(991.1,IEN,1,IEN2,10)),"^",1) Q:EXCTEXT=""
43 .S STR=$$SETSTR^VALM1("Exception Text:",STR,6,20)
44 .S X=EXCTEXT,DIWL=1,DIWR=50,DIWF="|" D ^DIWP
45 .F N=1:1:$P($G(^UTILITY($J,"W",1)),1) D Q:'N
46 ..S STR=$$SETSTR^VALM1(^UTILITY($J,"W",1,(N),0),STR,26,76)
47 ..D ADDTMP
48ADDNOTE ;Display Exception Notes, Word Processing field
49 S STR=$$SETSTR^VALM1("Exception Notes:",STR,6,20) D ADDTMP
50 N IEN,IEN2,IENS,N,NOTE
51 S IEN=$P(DATA,"^",10),IEN2=$P(DATA,"^",11),IENS=IEN2_","_IEN_",",N=$$GET1^DIQ(991.12,IENS,11,"","NT")
52 S L=0 F S L=$O(NT(L)) Q:'L S NOTE=NT(L),STR=$$SETSTR^VALM1(NOTE,STR,6,74) D ADDTMP
53 S VALMCNT=LIN-1,DFN=$P(DATA,"^",5),VAFCDFN=DFN
54 K L,NT
55 Q
56ADDTMP ;
57 S ^TMP("RGEXC2",$J,LIN,0)=STR,^TMP("RGEXC2",$J,"IDX",LIN,LIN)="",LIN=LIN+1,STR=""
58 Q
59UPD ;
60 N PROCDT,%,X,%I,%H
61 W !,"This option updates the exception status to PROCESSED.",!,"After it is processed it will not be listed in the summary."
62 S DIR("A")="Are you sure you want to change the status? ",DIR(0)="YA",DIR("B")="YES"
63 D ^DIR Q:$D(DIRUT) I Y>0 D
64 .;**48 populating the date/time marked as processed and who marked it as processed
65 .D NOW^%DTC S PROCDT=%
66 .S IEN="",IEN2="",IEN=$P(DATA,"^",10),IEN2=$P(DATA,"^",11) L +^RGHL7(991.1,IEN):10
67 .S DA(1)=IEN,DA=IEN2,DR="6///"_1_";7///"_PROCDT_";8///"_$G(DUZ),DIE="^RGHL7(991.1,"_DA(1)_",1," D ^DIE K DIE,DA,DR
68 .L -^RGHL7(991.1,IEN) S $P(DATA,"^",9)=1
69 .D INIT
70 K DIR,DIRUT S VALMBCK="R"
71 Q
72PA ;Patient Audit
73 S PDFN=DFN
74 I '$O(^DIA(2,"B",VAFCDFN,0)) S VALMSG="This patient has no audit data available.",VALMBCK="" G PAQ
75 N IEN S DFN=VAFCDFN,QFLG=1 D FULL^VALM1 D:$T(ASK2^RGMTAUD)]"" ASK2^RGMTAUD S VALMBCK="R"
76 S DFN=PDFN K QFLG,PDFN
77PAQ Q
78HI ;Hinq Inquiry
79 S VALMBCK="" D HINQ^DG10 D PAUSE^VALM1 S VALMBCK="R"
80 Q
81DISP ; Display Only Query
82 S VALMBCK="" D FULL^VALM1
83 S MPIVAR("DFN")=DFN,MPIVAR("SSN")=SSN,MPIVAR("NM")=NAME,MPIVAR("DOB")=$P($P(DATA,"^",7),".",1)
84 D VTQ^MPIFSAQ(.MPIVAR) D PAUSE^VALM1
85 S VALMBCK="R" K MPIVAR
86 Q
87 ;
88POT ;Potential Match on MPI, Query MPI, resolve duplicate if needed. **43 Added this entry point
89 D POT^MPIFDUP
90 D INIT S VALMBCK="R" K PROCESS
91 Q
92 ;
93REJ ;Primary View Reject. **44 Added entry point
94 D REJ^RGPVREJ
95 D INIT S VALMBCK="R"
96 Q
97 ;
98MPIPV ;MPI Primary View PDAT. **48 Added entry point
99 S SAPV=0 ;from EH, not stand alone option
100 D SEND^RGPVMPI
101 D INIT S VALMBCK="R"
102 Q
103 ;
104LOAD ; Edit Patient Data, if patient's eligibility is verified - check for DG ELIGIBILITY key for user
105 S VALMBCK="",DATAOLD=""
106 D FULL^VALM1 D ELIG^VADPT
107 I $P(VAEL(8),"^",1)="V" D
108 .I '$D(^XUSEC("DG ELIGIBILITY",DUZ)) D
109 ..W !!,"Eligibility has been verified for this patient.",!!,"You do not have access to edit the Name, Date of ",!,"Birth or Social Security Number for this patient."
110 ..D PAUSE^VALM1 S VALMBCK="R"
111 .E D SENS
112 E D SENS
113 Q
114SENS ; check for patient sensitivity and user security
115 N RESULT,RGSEN
116 D PTSEC^DGSEC4(.RESULT,DFN,0,"RG EXCEPTION HANDLING^MPI/PD Exception Handling")
117 I RESULT(1)=-1 W !!,"Access denied: Required parameters not defined" D PAUSE^VALM1 S VALMBCK="R" Q
118 I RESULT(1)>0 W !!?15,"***PATIENT MARKED SENSITIVE***"
119 I RESULT(1)=3 W !!?15,"Access not allowed on your own PATIENT (#2) file entry" D PAUSE^VALM1 S VALMBCK="R" Q
120 I RESULT(1)=4 W !!?15,"Access denied: Your SSN is not defined" D PAUSE^VALM1 S VALMBCK="R" Q
121 I RESULT(1)<3 D
122 .I RESULT(1)=1 D NOTICE^DGSEC4(.RGSEN,DFN,"RG EXCEPTION HANDLING^MPI/PD Exception Handling",2)
123 .I RESULT(1)=2 D NOTICE^DGSEC4(.RGSEN,DFN,"RG EXCEPTION HANDLING^MPI/PD Exception Handling",3)
124 D EDIT
125 Q
126EDIT ; edit patient data
127 S ACCESS=0
128 D REC
129 Q:ACCESS=0
130 S DIE="^DPT(",DA=DFN,DR=".01///^S X=$$NCEDIT^DPTNAME(DA);.03//^S X=DOB;.09//^S X=SSN"
131 L +^DPT(DFN):10 D ^DIE K DIE,DA,DR L -^DPT(DFN)
132 S DATAOLD=DATA
133 D DEATH
134 D DEM^VADPT
135 S DATA=VADM(1)_"^"_$P($G(VADM(2)),"^",1)_"^"_$P(DATAOLD,"^",3)_"^"_$P(DATAOLD,"^",4)_"^"_DFN_"^"_$P(DATAOLD,"^",6)_"^"
136 S DATA=DATA_$G(VADM(3))_"^"_$P(DATAOLD,"^",9)_"^"_$P(DATAOLD,"^",10)_"^"_$P(DATAOLD,"^",11)_"^"_$P(DATAOLD,"^",12)_"^"_$P($G(VADM(6)),"^",2)
137 D INIT
138 S VALMBCK="R"
139 K DGNEW,DATAOLD,VAEL,ACCESS,DGNPSSN
140QUIT Q
141REC ; Check if user is attempting to access own record
142 ; check for security key
143 I $D(^XUSEC("DG RECORD ACCESS",+DUZ)) S ACCESS=1 Q
144 S DGNPSSN=$$GET1^DIQ(200,+DUZ_",",9,"I","","DGNPERR")
145 I 'DGNPSSN D Q
146 .W !!,"Your SSN is missing from the NEW PERSON file.",!,"Contact your ADP Coordinator."
147 .D PAUSE^VALM1 S VALMBCK="R"
148 I DGNPSSN=SSN D Q
149 .W !!,"Security regulations prohibit computer access to your",!,"own medical record."
150 .D PAUSE^VALM1 S VALMBCK="R"
151 E S ACCESS=1
152 Q
153DEATH ; Check for access to edit date of death
154 I $D(^XUSEC("DG DETAIL",+DUZ)) D
155 .K VADM,DIE,DA,DR
156 .S DOD=""
157 .D DEM^VADPT
158 .S DOD=$P($G(VADM(6)),"^",2)
159 .S DIE="^DPT(",DA=DFN,DR=".351//^S X=DOD"
160 .L +^DPT(DFN):10
161 .D ^DIE
162 .L -^DPT(DFN)
163 E W !!,"You do not have the proper security to edit date of death." D PAUSE^VALM1 D INIT S VALMBCK="R"
164 K VADM,DIE,DA,DR,DOD
165 Q
166INQ ; Patient Inquiry
167 S VALMBCK=""
168 D FULL^VALM1 D EN^DGRPD D PAUSE^VALM1 D CLEAN^VALM10 D INIT
169 S VALMBCK="R"
170 Q
171EDTNOT ; Edit Exception Notes
172 S IEN=$P(DATA,"^",10),IEN2=$P(DATA,"^",11)
173 L +^RGHL7(991.1,IEN):10 S DIE="^RGHL7(991.1,"_IEN_",1,",DA(1)=IEN,DA=IEN2,DR="11" D ^DIE L -^RGHL7(991.1,IEN)
174 K DIE,DA,DR,IEN,IEN2
175 D INIT
176 S VALMBCK="R"
177 Q
178PDAT S VALMBCK="",PICN="",PSSN=""
179 I $D(SSN) S PSSN=SSN
180 S ARRAY="^TMP(""RGXHFS"","_$J_")",TYPE="I",REP=1,RGXDIR=$$GET^XPAR("SYS","RGX HFS SCRATCH"),RGXFILE="RGX"_DUZ_".DAT"
181 S IOM=132,IOSL=99999,IOST="P-DUMMY",IOF=""""""
182 D OPEN^%ZISH("RGX",RGXDIR,RGXFILE,"W") Q:POP
183 U IO
184 I ICN'="" S PICN=ICN D START^VAFCPDAT
185 N RGXDEL
186 D CLOSE^%ZISH("RGX")
187 K ^TMP("RGPDAT",$J)
188 S RGXDEL(RGXFILE)="",X=$$FTG^%ZISH(RGXDIR,RGXFILE,$NAME(^TMP("RGPDAT",$J,1)),3),X=$$DEL^%ZISH(RGXDIR,$NA(RGXDEL))
189 I $D(^TMP("RGPDAT",$J)) D EN^RGEX04
190 S ICN=PICN,SSN=PSSN
191 D INIT
192 S VALMBCK="R" K PICN,PSSN,ARRAY,REP,RGXDIR,RGXFILE,TYPE
193 Q
194GETEX(RETURN,DFN) ; Get array of pending exceptions for a patient
195 K RETURN
196 S CNT=0,RETURN(0)="0^No Pending Exceptions",TYP=""
197 I 'DFN S RETURN(0)="-1^DFN not passed" G QGET
198 F S TYP=$O(^RGHL7(991.1,"ADFN",TYP)) Q:'TYP D
199 .I $D(^RGHL7(991.1,"ADFN",TYP,DFN)) D
200 ..S IEN="" F S IEN=$O(^RGHL7(991.1,"ADFN",TYP,DFN,IEN)) Q:'IEN D
201 ...S IEN2="",ETYP="" F S IEN2=$O(^RGHL7(991.1,"ADFN",TYP,DFN,IEN,IEN2)) Q:'IEN2 D
202 ....I $P(^RGHL7(991.1,IEN,1,IEN2,0),"^",5)<1 D
203 .....S CNT=CNT+1,ETYP=$P(^RGHL7(991.11,TYP,10),"^",1)
204 .....S RETURN(CNT)=ETYP_"^"_IEN_"^"_IEN2
205 I CNT>0 S RETURN(0)=CNT_"^Pending Exception(s)"
206QGET ;
207 K TYP,ETYP,IEN,IEN2,CNT
208 Q
209HELP ; -- help code
210 S X="?" D DISP^XQORM1 W !!
211 Q
212EXIT ; -- exit code
213 S VALMBCK="" K ^TMP("RGEXC2",$J),CHKSM,DFN,DIR,EXCTEXT,IEN,IEN2,NAME,DOB,SSN,LIN,STATUS,STR,VAFCDFN,X,Y
214 S VALMBCK="R",RGBG=1
215 Q
216EXPND ; -- expand code
217 Q
Note: See TracBrowser for help on using the repository browser.