source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFCRAUD.m@ 1607

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

initial load of FOIAVistA 6/30/08 version
File size: 7.3 KB
Line 
1VAFCRAUD ;BHAM/DRI-ROUTINE TO CALL VAFC REMOTE AUDIT (PATIENT) ;2/22/02
2 ;;5.3;Registration;**477,479**;Aug 13, 1993
3 ;Reference to ^DGCN(391.91 supported by IA #2911
4 ;Reference to EN1^XWB2HL7 supported by IA #3144
5 ;Reference to RPCCHK^XWB2HL7 supported by IA #3144
6 ;Reference to RTNDATA^XWBDRPC supported by IA #3149
7ASK ;Ask For Patient
8 K DIRUT
9 W !!,"Patient lookup can be done by Patient Name, SSN or by ICN.",!
10 S DFN="",ICN=""
11 S DIC="^DPT(",DIC(0)="QEAM",DIC("A")="Select PATIENT: ",D="SSN^AICN^B^BS^BS5"
12 D MIX^DIC1 K DIC,D
13 I Y<0 S REXIT=1 G QUIT
14 S DFN=+Y
15 S ICN=+$$GETICN^MPIF001(DFN) I ICN<1 W !,"There is no Integration Control Number assigned to this patient,",!,"no treating facilities to query." G ASK
16 Q
17ASK2 ;Ask for Date Range
18 W !!,"Enter date range for data to be included in report."
19 K DIR,DIRUT,DTOUT,DUOUT
20 S DIR(0)="DAO^:DT:EPX",DIR("A")="Beginning Date: " D ^DIR K DIR G:$D(DIRUT) QUIT S VAFCBDT=Y
21 S DIR(0)="DAO^"_VAFCBDT_":DT:EPX",DIR("A")="Ending Date: " D ^DIR K DIR G:$D(DIRUT) QUIT S VAFCEDT=Y
22 ;
23 D SEND(ICN,VAFCBDT,VAFCEDT)
24 ;
25QUIT ;
26 K Y
27 Q
28 ;
29SEND(ICN,VAFCBDT,VAFCEDT) ;
30 N TFL,X,Y,SNTDT,MPIDIR
31 D GETTFL(ICN,.TFL)
32 I $D(^XTMP("VAFCRAUD"_ICN,0)) S SNTDT=$$FMTE^XLFDT($P(^XTMP("VAFCRAUD"_ICN,0),"^",2)) W !,"Query last sent for this ICN on "_SNTDT,!
33 I $P($G(TFL(0)),"^",1)=1 D
34 . D SELTF Q:((Y="")!(Y="^"))
35 . W !,"Remote patient data queries will be sent to: "
36 . S CNT=0,X=0 F S X=$O(TFARR(X)) Q:'X S CNT=CNT+1
37 . I CNT>22 D D2
38 . I CNT<23 D D1
39 . W ! K DIR S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Do you want to continue" D ^DIR S MPIDIR=+Y K DIR
40 . I MPIDIR=1 S X=0 F S X=$O(TFL(X)) Q:'X D
41 .. W !?3,"Sending Remote Query to: ",X," ",$P(TFL(X),"^")
42 .. I $D(^XTMP("VAFCRAUD"_ICN,X)) K ^XTMP("VAFCRAUD"_ICN,X)
43 .. D REQ(ICN,.TFL,X)
44 I '$D(TFL(0)) W !!?3,"There are no remote treating facilities listed for this patient.",!?3,"No remote query will be sent."
45 K ICNARR,X,Y,CNT,TFARR,TFL
46 Q
47SEND2 ;
48 N REXIT S REXIT=0
49 W !!,"This option sends a remote query to selected treating"
50 W !,"facility site(s) for MPI/PD data for a patient."
51 F D Q:REXIT=1
52 . D ASK
53 . I $D(Y) D SEND
54 K ICN,DFN
55 Q
56CHKSTAT(ICN) ;check on the status for a given ICN or SSN
57 N TFL,L,Y,ICNARR,STATUS,SL
58 W !!,"Checking the status of remote patient data query.",!
59 I '$D(^XTMP("VAFCRAUD"_ICN)) W !,"No remote query sent for this patient." Q
60 D GETTFL(ICN,.TFL)
61 W !!,"-> For ICN ",$P(ICN,"V",1),!
62 I $D(TFL(0)) D
63 . S X=0 F S X=$O(TFL(X)) Q:'X I '$D(^XTMP("VAFCRAUD"_ICN,X)) K TFL(X)
64 D SELTF
65 I '$D(TFARR) W !,"No remote query sent for this patient." Q
66 Q:((Y="")!(Y="^"))
67 S L=0 F S L=$O(TFARR(L)) Q:'L D
68 . S SL=$P(TFARR(L),"^",1)
69 . S STATUS=$P(TFL(SL),"^",3)
70 . I STATUS["Handle" S STATUS="Error in Process"
71 . E I STATUS["New" S STATUS="Request Sent"
72 . E I STATUS["Running" S STATUS="Awaiting Response"
73 . E I STATUS["Done" S STATUS="Response Received"
74 . W !?3," ",$P(TFL(SL),"^")," status: (",STATUS,")"
75 I '$D(TFL(0)) W !!?3,"There are no remote treating facilities listed for this patient.",!?3,"No remote query sent for this patient."
76 K ICNARR,L,SL,TFARR,TFL
77 Q
78CHKSTAT2 ;
79 N REXIT S REXIT=0
80 W !!,"This option checks the status of an existing remote patient data query."
81 F D Q:REXIT=1
82 . D ASK
83 . I $D(Y) D CHKSTAT
84 K ICN,DFN
85 Q
86DISP ;display returned AUDIT queries
87 W !!,"Display data returned from remote patient data queries."
88 W !,"(Be sure HISTORY is enabled to capture data!)",!
89 N TFL,L,Y,ICNARR,STATUS
90 I '$D(^XTMP("VAFCRAUD"_ICN)) W !!,"No remote query sent for this patient." Q
91 D GETTFL(ICN,.TFL)
92 W !!,"-> For ICN ",$P(ICN,"V",1),!
93 I $D(TFL(0)) D
94 . S X=0 F S X=$O(TFL(X)) Q:'X I '$D(^XTMP("VAFCRAUD"_ICN,X)) K TFL(X)
95 D SELTF
96 I '$D(TFARR) W !,"No remote query sent for this patient." Q
97 Q:((Y="")!(Y="^"))
98 S L=0 F S L=$O(TFARR(L)) Q:'L D
99 . S SL=$P(TFARR(L),"^",1)
100 . S STATUS=$P(TFL(SL),"^",3)
101 . I STATUS["Handle" S STATUS="Error in Process"
102 . E I STATUS["New" S STATUS="Request Sent"
103 . E I STATUS["Running" S STATUS="Awaiting Response"
104 . E I STATUS["Done" S STATUS="Response Received"
105 . W !?3," ",$P(TFL(SL),"^")," status: (",STATUS,")"
106 . D DISPLAY(ICN,$P(TFL(SL),"^",2))
107 I '$D(TFL(0)) W !?3,"There are no remote treating facilities listed for this patient.",!?3,"No remote query exists for this patient."
108 K ICNARR,L,SL,TFARR,TFL
109 Q
110DISP2 ;
111 N REXIT S REXIT=0
112 F D Q:REXIT=1
113 . D ASK
114 . I $D(Y) D DISP
115 K ICN,DFN
116 Q
117DISPLAY(ICN,LOC) ;display a remote audit report
118 N STATUS,RETURN,RESULT,RET,R
119 I '$D(^XTMP("VAFCRAUD"_ICN,0)) W !?15," - No audit query exists for this record."
120 I $D(^XTMP("VAFCRAUD"_ICN,LOC,0)) S RETURN(0)=$P(^XTMP("VAFCRAUD"_ICN,LOC,0),"^") D
121 . D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) I +RESULT(0)=1 D
122 .. D RTNDATA^XWBDRPC(.RET,RETURN(0))
123 .. I $D(RET(0)) I RET(0)<0 W !!,"No data returned due to: "_$P(RET(0),"^",2) Q
124 .. I $G(RET)'="",$D(@RET) S GLO=RET F S GLO=$Q(@GLO) Q:$QS(GLO,1)'=$J S TXT=@GLO W !,TXT I $Y>22 S DIR(0)="E" D ^DIR K DIR W @IOF S $Y=1 ;**479
125 .. S R="" F S R=$O(RET(R)) Q:R="" W !,RET(R) I $Y>22 S DIR(0)="E" D ^DIR K DIR W @IOF S $Y=1 ;**479
126 Q
127GETTFL(ICN,TFL) ;Check for existing Treating Facilities
128 N LOC,HOME
129 S HOME=$$SITE^VASITE()
130 S TF=0 F S TF=$O(^DGCN(391.91,"APAT",DFN,TF)) Q:'TF D
131 . S LOC=$$NNT^XUAF4(TF)
132 . I $P(LOC,"^",2)'=$E($P(HOME,"^",3),1,3) D
133 .. S TFL($P(LOC,"^",2))=LOC
134 .. S LOC=$P(LOC,"^",2)
135 .. D MONITOR(ICN,LOC,.RESULT)
136 .. S $P(TFL(LOC),"^",3)=$P(RESULT(0),"^",2)
137 I $O(TFL(0)) S TFL(0)=1
138 K TF
139 Q
140SELTF ;Allow the user to select treating facilites from a list
141 K TFARR,TFARR1
142 S I=0 F S I=$O(TFL(I)) Q:'I D
143 . S TFARR1($P(TFL(I),"^",1))=$P(TFL(I),"^",2)_"^"_$P(TFL(I),"^",1)
144 S I="",CNT=0 F S I=$O(TFARR1(I)) Q:I="" D
145 . S CNT=CNT+1 S TFARR(CNT)=TFARR1(I)
146 I CNT=1 S Y=1 Q
147 K DIR,Y
148 S CNT=CNT+1,TFARR(CNT)="ALL"
149 S DIR(0)="LA^1:"_CNT
150 S DIR("A")="Select site(s) 1-"_(CNT-1)_" or "_CNT_" for all: "
151 W !,"Select one or more of the following: "
152 I CNT>22 D D2
153 I CNT<23 D D1
154 D ^DIR K DIR
155 I Y<1 K TFARR,TFARR1,L,I,A,CNT Q
156 S Y=","_Y
157 I Y[(","_CNT_",") K TFARR(CNT),TFARR1,CNT,I Q
158 S I=0,A="" F S I=$O(TFARR(I)) Q:'I I Y'[(","_I_",") S A=$P(TFARR(I),"^",1) K TFL(A) K TFARR(I)
159 K L,I,A,TFARR(CNT),CNT,TFARR1
160 Q
161MONITOR(ICN,LOC,RESULT) ;
162 N STATUS,RETURN
163 I '$D(^XTMP("VAFCRAUD"_ICN,0)) S RESULT(0)="-1^Unknown" Q
164 I '$D(^XTMP("VAFCRAUD"_ICN,LOC,0)) S RESULT(0)="-1^Unknown" Q
165 I $D(^XTMP("VAFCRAUD"_ICN,LOC,0)) S RETURN(0)=$P(^XTMP("VAFCRAUD"_ICN,LOC,0),"^",1) D RPCCHK^XWB2HL7(.RESULT,RETURN(0))
166 Q
167REQ(ICN,TFL,LOC) ;request a remote audit report
168 ;LOC - STATION# OF THE INSTITUTION file entry
169 N VALUE S VALUE="ICN",VALUE(VALUE)=ICN
170 I +LOC>0 D EN1^XWB2HL7(.RETURN,LOC,"VAFC REMOTE AUDIT",1,.VALUE,"",VAFCBDT,VAFCEDT)
171 S ^XTMP("VAFCRAUD"_ICN,0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"REMOTE AUDIT QUERY"
172 S ^XTMP("VAFCRAUD"_ICN,LOC,0)=RETURN(0)_"^"_$$NOW^XLFDT
173 Q
174SENS ;Check for patient sensitivity
175 N RESULT
176 D PTSEC^DGSEC4(.RESULT,DFN,0,"RPC - VAFC REMOTE AUDIT^Remote Audit Query")
177 I RESULT(1)>0 D
178 . I '$D(^XUSEC("DG SENSITIVITY",DUZ)) D
179 . W !!,"PATIENT MARKED SENSITIVE."
180 . W !,"You do not have proper security to view this record."
181 Q
182D1 ;
183 S C1=1,I=0 F S I=$O(TFARR(I)) Q:'I D
184 . W !,C1_".",?4,"("_$P(TFARR(I),"^",1)_") "_$P(TFARR(I),"^",2) S C1=C1+1
185 K C1,I
186 Q
187D2 ;
188 S I2=23 F I=1:1:22 D
189 . W !,I_".",?4,"("_$P(TFARR(I),"^",1)_") "_$P(TFARR(I),"^",2)
190 . I $D(TFARR(I2)) W ?41,I2_". ",?44,"("_$P(TFARR(I2),"^",1)_") "_$P(TFARR(I2),"^",2) S I2=I2+1
191 K I,I2
192 Q
Note: See TracBrowser for help on using the repository browser.