RGEX05 ;BAY/ALS-LISTMANAGER ROUTINE FOR REMOTE PDAT IN EXCEPTION HANDLER ;10/04/01
;;1.0;CLINICAL INFO RESOURCE NETWORK;**23,20,31**;30 Apr 99
;Reference to RPCCHK^XWB2HL7 supported by IA #3144
;Reference to RTNDATA^XWBDRPC supported by IA #3149
EN(ICN) ;main entry point for RG EXCPT REMOTE PDAT
D EN^VALM("RG EXCPT RPDAT")
Q
HDR ;header code
S VALMHDR(1)="MPI/PD REMOTE PATIENT DATA"
S VALMHDR(2)=""
Q
INIT ;
K ^TMP("RGEXC5",$J)
K @VALMAR
I '$D(ICN) G EXIT
S LIN=1,X=0,STR="",TXT=""
S TXT="-> For ICN "_$P(ICN,"V",1) S STR=$$SETSTR^VALM1(TXT,STR,2,78) D ADDTMP
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"
. S TXT=" "_$P(TFL(SL),"^")_" status: ("_STATUS_")"
. D ADDTMP
. S STR=$$SETSTR^VALM1(TXT,STR,2,78) D ADDTMP D
. S LOC=$P(TFL(SL),"^",2)
. N STATUS,RETURN,RESULT,RET,RESULT
. I '$D(^XTMP("RGPDAT"_ICN,0)) S TXT=" - No patient data query exists for this patient." S STR=$$SETSTR^VALM1(TXT,STR,2,78) D ADDTMP
. I $D(^XTMP("RGPDAT"_ICN,LOC,0)) D
.. S RETURN(0)=$P(^XTMP("RGPDAT"_ICN,LOC,0),"^")
.. D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) I +RESULT(0)=1 D
... D RTNDATA^XWBDRPC(.RET,RETURN(0)) D
... I $G(RET(0))<0 S TXT="No Data Returned Due To: "_$P(RET(0),"^",2,99) S STR=$$SETSTR^VALM1(TXT,STR,2,78) D ADDTMP Q
... I $G(RET)'="",$D(@RET) S GLO=RET F S GLO=$Q(@GLO) Q:$QS(GLO,1)'=$J S TXT=@GLO S STR=$$SETSTR^VALM1(TXT,STR,2,78) D ADDTMP
... S R="" F S R=$O(RET(R)) Q:R="" S TXT=RET(R) S STR=$$SETSTR^VALM1(TXT,STR,2,78) D ADDTMP ;**31
K ICNARR,R,L,SL,LOC,TFL,GLO
S VALMCNT=LIN-1
Q
ADDTMP ;
S ^TMP("RGEXC5",$J,LIN,0)=STR
S ^TMP("RGEXC5",$J,"IDX",LIN,LIN)=""
S LIN=LIN+1,STR=""
Q
HELP ;
S X="?" D DISP^XQORM1 W !!
Q
EXIT ;
S VALMBCK=""
K ^TMP("RGEXC5",$J),LIN,X,STR,TXT
S VALMBCK="R"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGEX05 2031 printed Dec 13, 2024@01:41:44 Page 2
RGEX05 ;BAY/ALS-LISTMANAGER ROUTINE FOR REMOTE PDAT IN EXCEPTION HANDLER ;10/04/01
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**23,20,31**;30 Apr 99
+2 ;Reference to RPCCHK^XWB2HL7 supported by IA #3144
+3 ;Reference to RTNDATA^XWBDRPC supported by IA #3149
EN(ICN) ;main entry point for RG EXCPT REMOTE PDAT
+1 DO EN^VALM("RG EXCPT RPDAT")
+2 QUIT
HDR ;header code
+1 SET VALMHDR(1)="MPI/PD REMOTE PATIENT DATA"
+2 SET VALMHDR(2)=""
+3 QUIT
INIT ;
+1 KILL ^TMP("RGEXC5",$JOB)
+2 KILL @VALMAR
+3 IF '$DATA(ICN)
GOTO EXIT
+4 SET LIN=1
SET X=0
SET STR=""
SET TXT=""
+5 SET TXT="-> For ICN "_$PIECE(ICN,"V",1)
SET STR=$$SETSTR^VALM1(TXT,STR,2,78)
DO ADDTMP
+6 SET L=0
FOR
SET L=$ORDER(TFARR(L))
if 'L
QUIT
Begin DoDot:1
+7 SET SL=$PIECE(TFARR(L),"^",1)
+8 SET STATUS=$PIECE(TFL(SL),"^",3)
+9 IF STATUS["Handle"
SET STATUS="Error in Process"
+10 IF '$TEST
IF STATUS["New"
SET STATUS="Request Sent"
+11 IF '$TEST
IF STATUS["Running"
SET STATUS="Awaiting Response"
+12 IF '$TEST
IF STATUS["Done"
SET STATUS="Response Received"
+13 SET TXT=" "_$PIECE(TFL(SL),"^")_" status: ("_STATUS_")"
+14 DO ADDTMP
+15 SET STR=$$SETSTR^VALM1(TXT,STR,2,78)
DO ADDTMP
Begin DoDot:2
End DoDot:2
+16 SET LOC=$PIECE(TFL(SL),"^",2)
+17 NEW STATUS,RETURN,RESULT,RET,RESULT
+18 IF '$DATA(^XTMP("RGPDAT"_ICN,0))
SET TXT=" - No patient data query exists for this patient."
SET STR=$$SETSTR^VALM1(TXT,STR,2,78)
DO ADDTMP
+19 IF $DATA(^XTMP("RGPDAT"_ICN,LOC,0))
Begin DoDot:2
+20 SET RETURN(0)=$PIECE(^XTMP("RGPDAT"_ICN,LOC,0),"^")
+21 DO RPCCHK^XWB2HL7(.RESULT,RETURN(0))
IF +RESULT(0)=1
Begin DoDot:3
+22 DO RTNDATA^XWBDRPC(.RET,RETURN(0))
Begin DoDot:4
End DoDot:4
+23 IF $GET(RET(0))<0
SET TXT="No Data Returned Due To: "_$PIECE(RET(0),"^",2,99)
SET STR=$$SETSTR^VALM1(TXT,STR,2,78)
DO ADDTMP
QUIT
+24 IF $GET(RET)'=""
IF $DATA(@RET)
SET GLO=RET
FOR
SET GLO=$QUERY(@GLO)
if $QSUBSCRIPT(GLO,1)'=$JOB
QUIT
SET TXT=@GLO
SET STR=$$SETSTR^VALM1(TXT,STR,2,78)
DO ADDTMP
+25 ;**31
SET R=""
FOR
SET R=$ORDER(RET(R))
if R=""
QUIT
SET TXT=RET(R)
SET STR=$$SETSTR^VALM1(TXT,STR,2,78)
DO ADDTMP
End DoDot:3
End DoDot:2
End DoDot:1
+26 KILL ICNARR,R,L,SL,LOC,TFL,GLO
+27 SET VALMCNT=LIN-1
+28 QUIT
ADDTMP ;
+1 SET ^TMP("RGEXC5",$JOB,LIN,0)=STR
+2 SET ^TMP("RGEXC5",$JOB,"IDX",LIN,LIN)=""
+3 SET LIN=LIN+1
SET STR=""
+4 QUIT
HELP ;
+1 SET X="?"
DO DISP^XQORM1
WRITE !!
+2 QUIT
EXIT ;
+1 SET VALMBCK=""
+2 KILL ^TMP("RGEXC5",$JOB),LIN,X,STR,TXT
+3 SET VALMBCK="R"
+4 QUIT
