- RGRPDAT ;BAY/ALS-ROUTINE TO CALL REMOTE PDAT ;09/14/01
- ;;1.0;CLINICAL INFO RESOURCE NETWORK;**23,27,31,55,60**;30 Apr 99;Build 2
- ;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
- ;Reference to VAFC REMOTE PDAT supported by IA #3496
- 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
- SEND ;
- N TFL,X,Y,SNTDT,MPIDIR
- D GETTFL(ICN,.TFL)
- I $D(^XTMP("RGPDAT"_ICN,0)) S SNTDT=$$FMTE^XLFDT($P(^XTMP("RGPDAT"_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("RGPDAT"_ICN,X)) K ^XTMP("RGPDAT"_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 ;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("RGPDAT"_ICN)) W !!,"No remote query sent for this patient." Q
- D GETTFL(ICN,.TFL)
- N FULLICN S FULLICN=$$GETICN^MPIF001(DFN) W !!,"-> For ICN "_$S(+FULLICN>0:FULLICN,1:"") ;**60 - MVI_2389 (ptd)
- I $D(TFL(0)) D
- . S X=0 F S X=$O(TFL(X)) Q:'X I '$D(^XTMP("RGPDAT"_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 PDAT 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("RGPDAT"_ICN)) W !!,"No remote query sent for this patient." Q
- D GETTFL(ICN,.TFL)
- N FULLICN S FULLICN=$$GETICN^MPIF001(DFN) W !!,"-> For ICN "_$S(+FULLICN>0:FULLICN,1:"") ;**60 - MVI_2389 (ptd)
- I $D(TFL(0)) D
- . S X=0 F S X=$O(TFL(X)) Q:'X I '$D(^XTMP("RGPDAT"_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,STATUS,RESULT,RETURN
- 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 pdat report
- N STATUS,RETURN,RESULT,RET,R
- I '$D(^XTMP("RGPDAT"_ICN,0)) W !?15," - No patient data query exists for this record."
- I $D(^XTMP("RGPDAT"_ICN,LOC,0)) S RETURN(0)=$P(^XTMP("RGPDAT"_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 ;**31
- .. 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 ;**31
- .. 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 ;**31
- 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)&($P(LOC,"^",3)'="OTHER") 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("RGPDAT"_ICN,0)) S RESULT(0)="-1^Unknown" Q
- I '$D(^XTMP("RGPDAT"_ICN,LOC,0)) S RESULT(0)="-1^Unknown" Q
- I $D(^XTMP("RGPDAT"_ICN,LOC,0)) S RETURN(0)=$P(^XTMP("RGPDAT"_ICN,LOC,0),"^",1) D RPCCHK^XWB2HL7(.RESULT,RETURN(0))
- Q
- REQ(ICN,TFL,LOC) ;request a remote pdat report
- ;LOC - STATION# OF THE INSTITUTION file entry
- I +LOC>0 D EN1^XWB2HL7(.RETURN,LOC,"VAFC REMOTE PDAT",1,ICN,"")
- S ^XTMP("RGPDAT"_ICN,0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"REMOTE PDAT QUERY"
- S ^XTMP("RGPDAT"_ICN,LOC,0)=RETURN(0)_"^"_$$NOW^XLFDT
- Q
- SENS ;Check for patient sensitivity
- N RESULT
- D PTSEC^DGSEC4(.RESULT,DFN,0,"RPC - VAFC REMOTE PDAT^Remote Patient Data 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
- QUIT ;
- K Y
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGRPDAT 7439 printed Feb 18, 2025@23:09:11 Page 2
- RGRPDAT ;BAY/ALS-ROUTINE TO CALL REMOTE PDAT ;09/14/01
- +1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**23,27,31,55,60**;30 Apr 99;Build 2
- +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
- +6 ;Reference to VAFC REMOTE PDAT supported by IA #3496
- 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
- SEND ;
- +1 NEW TFL,X,Y,SNTDT,MPIDIR
- +2 DO GETTFL(ICN,.TFL)
- +3 IF $DATA(^XTMP("RGPDAT"_ICN,0))
- SET SNTDT=$$FMTE^XLFDT($PIECE(^XTMP("RGPDAT"_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("RGPDAT"_ICN,X))
- KILL ^XTMP("RGPDAT"_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 ;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("RGPDAT"_ICN))
- WRITE !!,"No remote query sent for this patient."
- QUIT
- +4 DO GETTFL(ICN,.TFL)
- +5 ;**60 - MVI_2389 (ptd)
- NEW FULLICN
- SET FULLICN=$$GETICN^MPIF001(DFN)
- WRITE !!,"-> For ICN "_$SELECT(+FULLICN>0:FULLICN,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("RGPDAT"_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 PDAT 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("RGPDAT"_ICN))
- WRITE !!,"No remote query sent for this patient."
- QUIT
- +5 DO GETTFL(ICN,.TFL)
- +6 ;**60 - MVI_2389 (ptd)
- NEW FULLICN
- SET FULLICN=$$GETICN^MPIF001(DFN)
- WRITE !!,"-> For ICN "_$SELECT(+FULLICN>0:FULLICN,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("RGPDAT"_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,STATUS,RESULT,RETURN
- +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 pdat report
- +1 NEW STATUS,RETURN,RESULT,RET,R
- +2 IF '$DATA(^XTMP("RGPDAT"_ICN,0))
- WRITE !?15," - No patient data query exists for this record."
- +3 IF $DATA(^XTMP("RGPDAT"_ICN,LOC,0))
- SET RETURN(0)=$PIECE(^XTMP("RGPDAT"_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 ;**31
- IF $DATA(RET(0))
- IF RET(0)<0
- WRITE !!,"No data returned due to: "_$PIECE(RET(0),"^",2)
- QUIT
- +7 ;**31
- 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 ;**31
- 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)&($PIECE(LOC,"^",3)'="OTHER")
- 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("RGPDAT"_ICN,0))
- SET RESULT(0)="-1^Unknown"
- QUIT
- +3 IF '$DATA(^XTMP("RGPDAT"_ICN,LOC,0))
- SET RESULT(0)="-1^Unknown"
- QUIT
- +4 IF $DATA(^XTMP("RGPDAT"_ICN,LOC,0))
- SET RETURN(0)=$PIECE(^XTMP("RGPDAT"_ICN,LOC,0),"^",1)
- DO RPCCHK^XWB2HL7(.RESULT,RETURN(0))
- +5 QUIT
- REQ(ICN,TFL,LOC) ;request a remote pdat report
- +1 ;LOC - STATION# OF THE INSTITUTION file entry
- +2 IF +LOC>0
- DO EN1^XWB2HL7(.RETURN,LOC,"VAFC REMOTE PDAT",1,ICN,"")
- +3 SET ^XTMP("RGPDAT"_ICN,0)=$$FMADD^XLFDT(DT,2)_"^"_DT_"^"_"REMOTE PDAT QUERY"
- +4 SET ^XTMP("RGPDAT"_ICN,LOC,0)=RETURN(0)_"^"_$$NOW^XLFDT
- +5 QUIT
- SENS ;Check for patient sensitivity
- +1 NEW RESULT
- +2 DO PTSEC^DGSEC4(.RESULT,DFN,0,"RPC - VAFC REMOTE PDAT^Remote Patient Data 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
- QUIT ;
- +1 KILL Y
- +2 QUIT