- 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 Feb 18, 2025@23:08:07 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