VAFCRAUD ;BHAM/DRI-ROUTINE TO CALL VAFC REMOTE AUDIT (PATIENT) ;2/22/02
;;5.3;Registration;**477,479**;Aug 13, 1993
;Reference to ^DGCN(391.91 supported by IA #2911
;Reference to EN1^XWB2HL7 supported by IA #3144
;Reference to RPCCHK^XWB2HL7 supported by IA #3144
;Reference to RTNDATA^XWBDRPC supported by IA #3149
ASK ;Ask For Patient
K DIRUT
W !!,"Patient lookup can be done by Patient Name, SSN or by ICN.",!
S DFN="",ICN=""
S DIC="^DPT(",DIC(0)="QEAM",DIC("A")="Select PATIENT: ",D="SSN^AICN^B^BS^BS5"
D MIX^DIC1 K DIC,D
I Y<0 S REXIT=1 G QUIT
S DFN=+Y
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
Q
ASK2 ;Ask for Date Range
W !!,"Enter date range for data to be included in report."
K DIR,DIRUT,DTOUT,DUOUT
S DIR(0)="DAO^:DT:EPX",DIR("A")="Beginning Date: " D ^DIR K DIR G:$D(DIRUT) QUIT S VAFCBDT=Y
S DIR(0)="DAO^"_VAFCBDT_":DT:EPX",DIR("A")="Ending Date: " D ^DIR K DIR G:$D(DIRUT) QUIT S VAFCEDT=Y
;
D SEND(ICN,VAFCBDT,VAFCEDT)
;
QUIT ;
K Y
Q
;
SEND(ICN,VAFCBDT,VAFCEDT) ;
N TFL,X,Y,SNTDT,MPIDIR
D GETTFL(ICN,.TFL)
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,!
I $P($G(TFL(0)),"^",1)=1 D
. D SELTF Q:((Y="")!(Y="^"))
. W !,"Remote patient data queries will be sent to: "
. S CNT=0,X=0 F S X=$O(TFARR(X)) Q:'X S CNT=CNT+1
. I CNT>22 D D2
. I CNT<23 D D1
. W ! K DIR S DIR(0)="Y",DIR("B")="Yes",DIR("A")="Do you want to continue" D ^DIR S MPIDIR=+Y K DIR
. I MPIDIR=1 S X=0 F S X=$O(TFL(X)) Q:'X D
.. W !?3,"Sending Remote Query to: ",X," ",$P(TFL(X),"^")
.. I $D(^XTMP("VAFCRAUD"_ICN,X)) K ^XTMP("VAFCRAUD"_ICN,X)
.. D REQ(ICN,.TFL,X)
I '$D(TFL(0)) W !!?3,"There are no remote treating facilities listed for this patient.",!?3,"No remote query will be sent."
K ICNARR,X,Y,CNT,TFARR,TFL
Q
SEND2 ;
N REXIT S REXIT=0
W !!,"This option sends a remote query to selected treating"
W !,"facility site(s) for MPI/PD data for a patient."
F D Q:REXIT=1
. D ASK
. I $D(Y) D SEND
K ICN,DFN
Q
CHKSTAT(ICN) ;check on the status for a given ICN or SSN
N TFL,L,Y,ICNARR,STATUS,SL
W !!,"Checking the status of remote patient data query.",!
I '$D(^XTMP("VAFCRAUD"_ICN)) W !,"No remote query sent for this patient." Q
D GETTFL(ICN,.TFL)
W !!,"-> For ICN ",$P(ICN,"V",1),!
I $D(TFL(0)) D
. S X=0 F S X=$O(TFL(X)) Q:'X I '$D(^XTMP("VAFCRAUD"_ICN,X)) K TFL(X)
D SELTF
I '$D(TFARR) W !,"No remote query sent for this patient." Q
Q:((Y="")!(Y="^"))
S L=0 F S L=$O(TFARR(L)) Q:'L D
. S SL=$P(TFARR(L),"^",1)
. S STATUS=$P(TFL(SL),"^",3)
. I STATUS["Handle" S STATUS="Error in Process"
. E I STATUS["New" S STATUS="Request Sent"
. E I STATUS["Running" S STATUS="Awaiting Response"
. E I STATUS["Done" S STATUS="Response Received"
. W !?3," ",$P(TFL(SL),"^")," status: (",STATUS,")"
I '$D(TFL(0)) W !!?3,"There are no remote treating facilities listed for this patient.",!?3,"No remote query sent for this patient."
K ICNARR,L,SL,TFARR,TFL
Q
CHKSTAT2 ;
N REXIT S REXIT=0
W !!,"This option checks the status of an existing remote patient data query."
F D Q:REXIT=1
. D ASK
. I $D(Y) D CHKSTAT
K ICN,DFN
Q
DISP ;display returned AUDIT queries
W !!,"Display data returned from remote patient data queries."
W !,"(Be sure HISTORY is enabled to capture data!)",!
N TFL,L,Y,ICNARR,STATUS
I '$D(^XTMP("VAFCRAUD"_ICN)) W !!,"No remote query sent for this patient." Q
D GETTFL(ICN,.TFL)
W !!,"-> For ICN ",$P(ICN,"V",1),!
I $D(TFL(0)) D
. S X=0 F S X=$O(TFL(X)) Q:'X I '$D(^XTMP("VAFCRAUD"_ICN,X)) K TFL(X)
D SELTF
I '$D(TFARR) W !,"No remote query sent for this patient." Q
Q:((Y="")!(Y="^"))
S L=0 F S L=$O(TFARR(L)) Q:'L D
. S SL=$P(TFARR(L),"^",1)
. S STATUS=$P(TFL(SL),"^",3)
. I STATUS["Handle" S STATUS="Error in Process"
. E I STATUS["New" S STATUS="Request Sent"
. E I STATUS["Running" S STATUS="Awaiting Response"
. E I STATUS["Done" S STATUS="Response Received"
. W !?3," ",$P(TFL(SL),"^")," status: (",STATUS,")"
. D DISPLAY(ICN,$P(TFL(SL),"^",2))
I '$D(TFL(0)) W !?3,"There are no remote treating facilities listed for this patient.",!?3,"No remote query exists for this patient."
K ICNARR,L,SL,TFARR,TFL
Q
DISP2 ;
N REXIT S REXIT=0
F D Q:REXIT=1
. D ASK
. I $D(Y) D DISP
K ICN,DFN
Q
DISPLAY(ICN,LOC) ;display a remote audit report
N STATUS,RETURN,RESULT,RET,R
I '$D(^XTMP("VAFCRAUD"_ICN,0)) W !?15," - No audit query exists for this record."
I $D(^XTMP("VAFCRAUD"_ICN,LOC,0)) S RETURN(0)=$P(^XTMP("VAFCRAUD"_ICN,LOC,0),"^") D
. D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) I +RESULT(0)=1 D
.. D RTNDATA^XWBDRPC(.RET,RETURN(0))
.. I $D(RET(0)) I RET(0)<0 W !!,"No data returned due to: "_$P(RET(0),"^",2) Q
.. 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
.. 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
Q
GETTFL(ICN,TFL) ;Check for existing Treating Facilities
N LOC,HOME
S HOME=$$SITE^VASITE()
S TF=0 F S TF=$O(^DGCN(391.91,"APAT",DFN,TF)) Q:'TF D
. S LOC=$$NNT^XUAF4(TF)
. I $P(LOC,"^",2)'=$E($P(HOME,"^",3),1,3) D
.. S TFL($P(LOC,"^",2))=LOC
.. S LOC=$P(LOC,"^",2)
.. D MONITOR(ICN,LOC,.RESULT)
.. S $P(TFL(LOC),"^",3)=$P(RESULT(0),"^",2)
I $O(TFL(0)) S TFL(0)=1
K TF
Q
SELTF ;Allow the user to select treating facilites from a list
K TFARR,TFARR1
S I=0 F S I=$O(TFL(I)) Q:'I D
. S TFARR1($P(TFL(I),"^",1))=$P(TFL(I),"^",2)_"^"_$P(TFL(I),"^",1)
S I="",CNT=0 F S I=$O(TFARR1(I)) Q:I="" D
. S CNT=CNT+1 S TFARR(CNT)=TFARR1(I)
I CNT=1 S Y=1 Q
K DIR,Y
S CNT=CNT+1,TFARR(CNT)="ALL"
S DIR(0)="LA^1:"_CNT
S DIR("A")="Select site(s) 1-"_(CNT-1)_" or "_CNT_" for all: "
W !,"Select one or more of the following: "
I CNT>22 D D2
I CNT<23 D D1
D ^DIR K DIR
I Y<1 K TFARR,TFARR1,L,I,A,CNT Q
S Y=","_Y
I Y[(","_CNT_",") K TFARR(CNT),TFARR1,CNT,I Q
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)
K L,I,A,TFARR(CNT),CNT,TFARR1
Q
MONITOR(ICN,LOC,RESULT) ;
N STATUS,RETURN
I '$D(^XTMP("VAFCRAUD"_ICN,0)) S RESULT(0)="-1^Unknown" Q
I '$D(^XTMP("VAFCRAUD"_ICN,LOC,0)) S RESULT(0)="-1^Unknown" Q
I $D(^XTMP("VAFCRAUD"_ICN,LOC,0)) S RETURN(0)=$P(^XTMP("VAFCRAUD"_ICN,LOC,0),"^",1) D RPCCHK^XWB2HL7(.RESULT,RETURN(0))
Q
REQ(ICN,TFL,LOC) ;request a remote audit report
;LOC - STATION# OF THE INSTITUTION file entry
N VALUE S VALUE="ICN",VALUE(VALUE)=ICN
I +LOC>0 D EN1^XWB2HL7(.RETURN,LOC,"VAFC REMOTE AUDIT",1,.VALUE,"",VAFCBDT,VAFCEDT)
S ^XTMP("VAFCRAUD"_ICN,0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"REMOTE AUDIT QUERY"
S ^XTMP("VAFCRAUD"_ICN,LOC,0)=RETURN(0)_"^"_$$NOW^XLFDT
Q
SENS ;Check for patient sensitivity
N RESULT
D PTSEC^DGSEC4(.RESULT,DFN,0,"RPC - VAFC REMOTE AUDIT^Remote Audit Query")
I RESULT(1)>0 D
. I '$D(^XUSEC("DG SENSITIVITY",DUZ)) D
. W !!,"PATIENT MARKED SENSITIVE."
. W !,"You do not have proper security to view this record."
Q
D1 ;
S C1=1,I=0 F S I=$O(TFARR(I)) Q:'I D
. W !,C1_".",?4,"("_$P(TFARR(I),"^",1)_") "_$P(TFARR(I),"^",2) S C1=C1+1
K C1,I
Q
D2 ;
S I2=23 F I=1:1:22 D
. W !,I_".",?4,"("_$P(TFARR(I),"^",1)_") "_$P(TFARR(I),"^",2)
. I $D(TFARR(I2)) W ?41,I2_". ",?44,"("_$P(TFARR(I2),"^",1)_") "_$P(TFARR(I2),"^",2) S I2=I2+1
K I,I2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCRAUD 7630 printed Dec 13, 2024@03:02:20 Page 2
VAFCRAUD ;BHAM/DRI-ROUTINE TO CALL VAFC REMOTE AUDIT (PATIENT) ;2/22/02
+1 ;;5.3;Registration;**477,479**;Aug 13, 1993
+2 ;Reference to ^DGCN(391.91 supported by IA #2911
+3 ;Reference to EN1^XWB2HL7 supported by IA #3144
+4 ;Reference to RPCCHK^XWB2HL7 supported by IA #3144
+5 ;Reference to RTNDATA^XWBDRPC supported by IA #3149
ASK ;Ask For Patient
+1 KILL DIRUT
+2 WRITE !!,"Patient lookup can be done by Patient Name, SSN or by ICN.",!
+3 SET DFN=""
SET ICN=""
+4 SET DIC="^DPT("
SET DIC(0)="QEAM"
SET DIC("A")="Select PATIENT: "
SET D="SSN^AICN^B^BS^BS5"
+5 DO MIX^DIC1
KILL DIC,D
+6 IF Y<0
SET REXIT=1
GOTO QUIT
+7 SET DFN=+Y
+8 SET ICN=+$$GETICN^MPIF001(DFN)
IF ICN<1
WRITE !,"There is no Integration Control Number assigned to this patient,",!,"no treating facilities to query."
GOTO ASK
+9 QUIT
ASK2 ;Ask for Date Range
+1 WRITE !!,"Enter date range for data to be included in report."
+2 KILL DIR,DIRUT,DTOUT,DUOUT
+3 SET DIR(0)="DAO^:DT:EPX"
SET DIR("A")="Beginning Date: "
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO QUIT
SET VAFCBDT=Y
+4 SET DIR(0)="DAO^"_VAFCBDT_":DT:EPX"
SET DIR("A")="Ending Date: "
DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO QUIT
SET VAFCEDT=Y
+5 ;
+6 DO SEND(ICN,VAFCBDT,VAFCEDT)
+7 ;
QUIT ;
+1 KILL Y
+2 QUIT
+3 ;
SEND(ICN,VAFCBDT,VAFCEDT) ;
+1 NEW TFL,X,Y,SNTDT,MPIDIR
+2 DO GETTFL(ICN,.TFL)
+3 IF $DATA(^XTMP("VAFCRAUD"_ICN,0))
SET SNTDT=$$FMTE^XLFDT($PIECE(^XTMP("VAFCRAUD"_ICN,0),"^",2))
WRITE !,"Query last sent for this ICN on "_SNTDT,!
+4 IF $PIECE($GET(TFL(0)),"^",1)=1
Begin DoDot:1
+5 DO SELTF
if ((Y="")!(Y="^"))
QUIT
+6 WRITE !,"Remote patient data queries will be sent to: "
+7 SET CNT=0
SET X=0
FOR
SET X=$ORDER(TFARR(X))
if 'X
QUIT
SET CNT=CNT+1
+8 IF CNT>22
DO D2
+9 IF CNT<23
DO D1
+10 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("B")="Yes"
SET DIR("A")="Do you want to continue"
DO ^DIR
SET MPIDIR=+Y
KILL DIR
+11 IF MPIDIR=1
SET X=0
FOR
SET X=$ORDER(TFL(X))
if 'X
QUIT
Begin DoDot:2
+12 WRITE !?3,"Sending Remote Query to: ",X," ",$PIECE(TFL(X),"^")
+13 IF $DATA(^XTMP("VAFCRAUD"_ICN,X))
KILL ^XTMP("VAFCRAUD"_ICN,X)
+14 DO REQ(ICN,.TFL,X)
End DoDot:2
End DoDot:1
+15 IF '$DATA(TFL(0))
WRITE !!?3,"There are no remote treating facilities listed for this patient.",!?3,"No remote query will be sent."
+16 KILL ICNARR,X,Y,CNT,TFARR,TFL
+17 QUIT
SEND2 ;
+1 NEW REXIT
SET REXIT=0
+2 WRITE !!,"This option sends a remote query to selected treating"
+3 WRITE !,"facility site(s) for MPI/PD data for a patient."
+4 FOR
Begin DoDot:1
+5 DO ASK
+6 IF $DATA(Y)
DO SEND
End DoDot:1
if REXIT=1
QUIT
+7 KILL ICN,DFN
+8 QUIT
CHKSTAT(ICN) ;check on the status for a given ICN or SSN
+1 NEW TFL,L,Y,ICNARR,STATUS,SL
+2 WRITE !!,"Checking the status of remote patient data query.",!
+3 IF '$DATA(^XTMP("VAFCRAUD"_ICN))
WRITE !,"No remote query sent for this patient."
QUIT
+4 DO GETTFL(ICN,.TFL)
+5 WRITE !!,"-> For ICN ",$PIECE(ICN,"V",1),!
+6 IF $DATA(TFL(0))
Begin DoDot:1
+7 SET X=0
FOR
SET X=$ORDER(TFL(X))
if 'X
QUIT
IF '$DATA(^XTMP("VAFCRAUD"_ICN,X))
KILL TFL(X)
End DoDot:1
+8 DO SELTF
+9 IF '$DATA(TFARR)
WRITE !,"No remote query sent for this patient."
QUIT
+10 if ((Y="")!(Y="^"))
QUIT
+11 SET L=0
FOR
SET L=$ORDER(TFARR(L))
if 'L
QUIT
Begin DoDot:1
+12 SET SL=$PIECE(TFARR(L),"^",1)
+13 SET STATUS=$PIECE(TFL(SL),"^",3)
+14 IF STATUS["Handle"
SET STATUS="Error in Process"
+15 IF '$TEST
IF STATUS["New"
SET STATUS="Request Sent"
+16 IF '$TEST
IF STATUS["Running"
SET STATUS="Awaiting Response"
+17 IF '$TEST
IF STATUS["Done"
SET STATUS="Response Received"
+18 WRITE !?3," ",$PIECE(TFL(SL),"^")," status: (",STATUS,")"
End DoDot:1
+19 IF '$DATA(TFL(0))
WRITE !!?3,"There are no remote treating facilities listed for this patient.",!?3,"No remote query sent for this patient."
+20 KILL ICNARR,L,SL,TFARR,TFL
+21 QUIT
CHKSTAT2 ;
+1 NEW REXIT
SET REXIT=0
+2 WRITE !!,"This option checks the status of an existing remote patient data query."
+3 FOR
Begin DoDot:1
+4 DO ASK
+5 IF $DATA(Y)
DO CHKSTAT
End DoDot:1
if REXIT=1
QUIT
+6 KILL ICN,DFN
+7 QUIT
DISP ;display returned AUDIT queries
+1 WRITE !!,"Display data returned from remote patient data queries."
+2 WRITE !,"(Be sure HISTORY is enabled to capture data!)",!
+3 NEW TFL,L,Y,ICNARR,STATUS
+4 IF '$DATA(^XTMP("VAFCRAUD"_ICN))
WRITE !!,"No remote query sent for this patient."
QUIT
+5 DO GETTFL(ICN,.TFL)
+6 WRITE !!,"-> For ICN ",$PIECE(ICN,"V",1),!
+7 IF $DATA(TFL(0))
Begin DoDot:1
+8 SET X=0
FOR
SET X=$ORDER(TFL(X))
if 'X
QUIT
IF '$DATA(^XTMP("VAFCRAUD"_ICN,X))
KILL TFL(X)
End DoDot:1
+9 DO SELTF
+10 IF '$DATA(TFARR)
WRITE !,"No remote query sent for this patient."
QUIT
+11 if ((Y="")!(Y="^"))
QUIT
+12 SET L=0
FOR
SET L=$ORDER(TFARR(L))
if 'L
QUIT
Begin DoDot:1
+13 SET SL=$PIECE(TFARR(L),"^",1)
+14 SET STATUS=$PIECE(TFL(SL),"^",3)
+15 IF STATUS["Handle"
SET STATUS="Error in Process"
+16 IF '$TEST
IF STATUS["New"
SET STATUS="Request Sent"
+17 IF '$TEST
IF STATUS["Running"
SET STATUS="Awaiting Response"
+18 IF '$TEST
IF STATUS["Done"
SET STATUS="Response Received"
+19 WRITE !?3," ",$PIECE(TFL(SL),"^")," status: (",STATUS,")"
+20 DO DISPLAY(ICN,$PIECE(TFL(SL),"^",2))
End DoDot:1
+21 IF '$DATA(TFL(0))
WRITE !?3,"There are no remote treating facilities listed for this patient.",!?3,"No remote query exists for this patient."
+22 KILL ICNARR,L,SL,TFARR,TFL
+23 QUIT
DISP2 ;
+1 NEW REXIT
SET REXIT=0
+2 FOR
Begin DoDot:1
+3 DO ASK
+4 IF $DATA(Y)
DO DISP
End DoDot:1
if REXIT=1
QUIT
+5 KILL ICN,DFN
+6 QUIT
DISPLAY(ICN,LOC) ;display a remote audit report
+1 NEW STATUS,RETURN,RESULT,RET,R
+2 IF '$DATA(^XTMP("VAFCRAUD"_ICN,0))
WRITE !?15," - No audit query exists for this record."
+3 IF $DATA(^XTMP("VAFCRAUD"_ICN,LOC,0))
SET RETURN(0)=$PIECE(^XTMP("VAFCRAUD"_ICN,LOC,0),"^")
Begin DoDot:1
+4 DO RPCCHK^XWB2HL7(.RESULT,RETURN(0))
IF +RESULT(0)=1
Begin DoDot:2
+5 DO RTNDATA^XWBDRPC(.RET,RETURN(0))
+6 IF $DATA(RET(0))
IF RET(0)<0
WRITE !!,"No data returned due to: "_$PIECE(RET(0),"^",2)
QUIT
+7 ;**479
IF $GET(RET)'=""
IF $DATA(@RET)
SET GLO=RET
FOR
SET GLO=$QUERY(@GLO)
if $QSUBSCRIPT(GLO,1)'=$JOB
QUIT
SET TXT=@GLO
WRITE !,TXT
IF $Y>22
SET DIR(0)="E"
DO ^DIR
KILL DIR
WRITE @IOF
SET $Y=1
+8 ;**479
SET R=""
FOR
SET R=$ORDER(RET(R))
if R=""
QUIT
WRITE !,RET(R)
IF $Y>22
SET DIR(0)="E"
DO ^DIR
KILL DIR
WRITE @IOF
SET $Y=1
End DoDot:2
End DoDot:1
+9 QUIT
GETTFL(ICN,TFL) ;Check for existing Treating Facilities
+1 NEW LOC,HOME
+2 SET HOME=$$SITE^VASITE()
+3 SET TF=0
FOR
SET TF=$ORDER(^DGCN(391.91,"APAT",DFN,TF))
if 'TF
QUIT
Begin DoDot:1
+4 SET LOC=$$NNT^XUAF4(TF)
+5 IF $PIECE(LOC,"^",2)'=$EXTRACT($PIECE(HOME,"^",3),1,3)
Begin DoDot:2
+6 SET TFL($PIECE(LOC,"^",2))=LOC
+7 SET LOC=$PIECE(LOC,"^",2)
+8 DO MONITOR(ICN,LOC,.RESULT)
+9 SET $PIECE(TFL(LOC),"^",3)=$PIECE(RESULT(0),"^",2)
End DoDot:2
End DoDot:1
+10 IF $ORDER(TFL(0))
SET TFL(0)=1
+11 KILL TF
+12 QUIT
SELTF ;Allow the user to select treating facilites from a list
+1 KILL TFARR,TFARR1
+2 SET I=0
FOR
SET I=$ORDER(TFL(I))
if 'I
QUIT
Begin DoDot:1
+3 SET TFARR1($PIECE(TFL(I),"^",1))=$PIECE(TFL(I),"^",2)_"^"_$PIECE(TFL(I),"^",1)
End DoDot:1
+4 SET I=""
SET CNT=0
FOR
SET I=$ORDER(TFARR1(I))
if I=""
QUIT
Begin DoDot:1
+5 SET CNT=CNT+1
SET TFARR(CNT)=TFARR1(I)
End DoDot:1
+6 IF CNT=1
SET Y=1
QUIT
+7 KILL DIR,Y
+8 SET CNT=CNT+1
SET TFARR(CNT)="ALL"
+9 SET DIR(0)="LA^1:"_CNT
+10 SET DIR("A")="Select site(s) 1-"_(CNT-1)_" or "_CNT_" for all: "
+11 WRITE !,"Select one or more of the following: "
+12 IF CNT>22
DO D2
+13 IF CNT<23
DO D1
+14 DO ^DIR
KILL DIR
+15 IF Y<1
KILL TFARR,TFARR1,L,I,A,CNT
QUIT
+16 SET Y=","_Y
+17 IF Y[(","_CNT_",")
KILL TFARR(CNT),TFARR1,CNT,I
QUIT
+18 SET I=0
SET A=""
FOR
SET I=$ORDER(TFARR(I))
if 'I
QUIT
IF Y'[(","_I_",")
SET A=$PIECE(TFARR(I),"^",1)
KILL TFL(A)
KILL TFARR(I)
+19 KILL L,I,A,TFARR(CNT),CNT,TFARR1
+20 QUIT
MONITOR(ICN,LOC,RESULT) ;
+1 NEW STATUS,RETURN
+2 IF '$DATA(^XTMP("VAFCRAUD"_ICN,0))
SET RESULT(0)="-1^Unknown"
QUIT
+3 IF '$DATA(^XTMP("VAFCRAUD"_ICN,LOC,0))
SET RESULT(0)="-1^Unknown"
QUIT
+4 IF $DATA(^XTMP("VAFCRAUD"_ICN,LOC,0))
SET RETURN(0)=$PIECE(^XTMP("VAFCRAUD"_ICN,LOC,0),"^",1)
DO RPCCHK^XWB2HL7(.RESULT,RETURN(0))
+5 QUIT
REQ(ICN,TFL,LOC) ;request a remote audit report
+1 ;LOC - STATION# OF THE INSTITUTION file entry
+2 NEW VALUE
SET VALUE="ICN"
SET VALUE(VALUE)=ICN
+3 IF +LOC>0
DO EN1^XWB2HL7(.RETURN,LOC,"VAFC REMOTE AUDIT",1,.VALUE,"",VAFCBDT,VAFCEDT)
+4 SET ^XTMP("VAFCRAUD"_ICN,0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"REMOTE AUDIT QUERY"
+5 SET ^XTMP("VAFCRAUD"_ICN,LOC,0)=RETURN(0)_"^"_$$NOW^XLFDT
+6 QUIT
SENS ;Check for patient sensitivity
+1 NEW RESULT
+2 DO PTSEC^DGSEC4(.RESULT,DFN,0,"RPC - VAFC REMOTE AUDIT^Remote Audit Query")
+3 IF RESULT(1)>0
Begin DoDot:1
+4 IF '$DATA(^XUSEC("DG SENSITIVITY",DUZ))
Begin DoDot:2
End DoDot:2
+5 WRITE !!,"PATIENT MARKED SENSITIVE."
+6 WRITE !,"You do not have proper security to view this record."
End DoDot:1
+7 QUIT
D1 ;
+1 SET C1=1
SET I=0
FOR
SET I=$ORDER(TFARR(I))
if 'I
QUIT
Begin DoDot:1
+2 WRITE !,C1_".",?4,"("_$PIECE(TFARR(I),"^",1)_") "_$PIECE(TFARR(I),"^",2)
SET C1=C1+1
End DoDot:1
+3 KILL C1,I
+4 QUIT
D2 ;
+1 SET I2=23
FOR I=1:1:22
Begin DoDot:1
+2 WRITE !,I_".",?4,"("_$PIECE(TFARR(I),"^",1)_") "_$PIECE(TFARR(I),"^",2)
+3 IF $DATA(TFARR(I2))
WRITE ?41,I2_". ",?44,"("_$PIECE(TFARR(I2),"^",1)_") "_$PIECE(TFARR(I2),"^",2)
SET I2=I2+1
End DoDot:1
+4 KILL I,I2
+5 QUIT
