- RGEX06 ;BIR/PTD-LIST MANAGER ROUTINE FOR REMOTE MPI PRIMARY VIEW PDAT ;5/17/07
- ;;1.0;CLINICAL INFO RESOURCE NETWORK;**48,53**;30 Apr 99;Build 2
- ;
- ;Reference to ^XWB2HL7 supported by IA #3144
- ;Reference to ^XWBDRPC supported by IA #3149
- ;
- EN(ICN) ;Entry point calling List Template for primary view PDAT display
- D EN^VALM("RG EXCPT PV MPI PDAT")
- Q
- ;
- HDR ; -- header code
- S VALMHDR(1)="MPI PRIMARY VIEW PATIENT DATA DISPLAY"
- Q
- ;
- INIT ;Display the MPI Primary View Patient Data (PDAT)
- K ^TMP("RGEXC6",$J)
- K @VALMAR
- I '$D(ICN) G EXIT
- S LIN=1,X=0,STR="",TXT=""
- I '$D(^XTMP("RGPVMPI"_ICN,"DATA")) S TXT=" - No MPI Primary View data exists for this patient." D ADDTMP
- N STATUS,R,RETURN,RESULT,RET
- I $D(^XTMP("RGPVMPI"_ICN,"DATA")) S RETURN(0)=$P(^XTMP("RGPVMPI"_ICN,"DATA"),"^") D
- .D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) I +RESULT(0)=1 D
- ..;Retrieve the data
- ..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,1,80) 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,1,80) D ADDTMP
- ...S R="" F S R=$O(RET(R)) Q:R="" S TXT=RET(R) S STR=$$SETSTR^VALM1(TXT,STR,1,80) D ADDTMP
- K GLO,L,R,SL
- S VALMCNT=LIN-1
- Q
- ;
- ADDTMP ;Set string into the array.
- S ^TMP("RGEXC6",$J,LIN,0)=STR
- S ^TMP("RGEXC6",$J,"IDX",LIN,LIN)=""
- S LIN=LIN+1,STR=""
- Q
- ;
- HELP ; -- help code
- S X="?" D DISP^XQORM1 W !!
- Q
- ;
- EXIT ; -- exit code
- S VALMBCK=""
- K ^TMP("RGEXC6",$J),GLO,L,LIN,R,RESULT,RET,RETURN,SL,STATUS,STR,TXT,X
- S VALMBCK="R"
- Q
- ;
- EXPND ; -- expand code
- Q
- ;
- SAPV(ICN) ;Print stand alone Primary View display
- I '$D(^XTMP("RGPVMPI"_ICN,"DATA")) W !," - No MPI Primary View data exists for this patient." Q
- N STATUS,R,RETURN,RESULT,RET
- I $D(^XTMP("RGPVMPI"_ICN,"DATA")) S RETURN(0)=$P(^XTMP("RGPVMPI"_ICN,"DATA"),"^") D
- .D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) I +RESULT(0)=1 D
- ..;Retrieve the data
- ..D RTNDATA^XWBDRPC(.RET,RETURN(0)) D
- ...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
- ...S R="" F S R=$O(RET(R)) Q:R="" W !,RET(R) I $Y>22 S DIR(0)="E" D ^DIR K DIR Q:'Y W @IOF S $Y=1
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGEX06 2394 printed Feb 18, 2025@23:08:08 Page 2
- RGEX06 ;BIR/PTD-LIST MANAGER ROUTINE FOR REMOTE MPI PRIMARY VIEW PDAT ;5/17/07
- +1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**48,53**;30 Apr 99;Build 2
- +2 ;
- +3 ;Reference to ^XWB2HL7 supported by IA #3144
- +4 ;Reference to ^XWBDRPC supported by IA #3149
- +5 ;
- EN(ICN) ;Entry point calling List Template for primary view PDAT display
- +1 DO EN^VALM("RG EXCPT PV MPI PDAT")
- +2 QUIT
- +3 ;
- HDR ; -- header code
- +1 SET VALMHDR(1)="MPI PRIMARY VIEW PATIENT DATA DISPLAY"
- +2 QUIT
- +3 ;
- INIT ;Display the MPI Primary View Patient Data (PDAT)
- +1 KILL ^TMP("RGEXC6",$JOB)
- +2 KILL @VALMAR
- +3 IF '$DATA(ICN)
- GOTO EXIT
- +4 SET LIN=1
- SET X=0
- SET STR=""
- SET TXT=""
- +5 IF '$DATA(^XTMP("RGPVMPI"_ICN,"DATA"))
- SET TXT=" - No MPI Primary View data exists for this patient."
- DO ADDTMP
- +6 NEW STATUS,R,RETURN,RESULT,RET
- +7 IF $DATA(^XTMP("RGPVMPI"_ICN,"DATA"))
- SET RETURN(0)=$PIECE(^XTMP("RGPVMPI"_ICN,"DATA"),"^")
- Begin DoDot:1
- +8 DO RPCCHK^XWB2HL7(.RESULT,RETURN(0))
- IF +RESULT(0)=1
- Begin DoDot:2
- +9 ;Retrieve the data
- +10 DO RTNDATA^XWBDRPC(.RET,RETURN(0))
- Begin DoDot:3
- +11 IF $GET(RET(0))<0
- SET TXT="No Data Returned Due To: "_$PIECE(RET(0),"^",2,99)
- SET STR=$$SETSTR^VALM1(TXT,STR,1,80)
- DO ADDTMP
- QUIT
- +12 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,1,80)
- DO ADDTMP
- +13 SET R=""
- FOR
- SET R=$ORDER(RET(R))
- if R=""
- QUIT
- SET TXT=RET(R)
- SET STR=$$SETSTR^VALM1(TXT,STR,1,80)
- DO ADDTMP
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +14 KILL GLO,L,R,SL
- +15 SET VALMCNT=LIN-1
- +16 QUIT
- +17 ;
- ADDTMP ;Set string into the array.
- +1 SET ^TMP("RGEXC6",$JOB,LIN,0)=STR
- +2 SET ^TMP("RGEXC6",$JOB,"IDX",LIN,LIN)=""
- +3 SET LIN=LIN+1
- SET STR=""
- +4 QUIT
- +5 ;
- HELP ; -- help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
- +3 ;
- EXIT ; -- exit code
- +1 SET VALMBCK=""
- +2 KILL ^TMP("RGEXC6",$JOB),GLO,L,LIN,R,RESULT,RET,RETURN,SL,STATUS,STR,TXT,X
- +3 SET VALMBCK="R"
- +4 QUIT
- +5 ;
- EXPND ; -- expand code
- +1 QUIT
- +2 ;
- SAPV(ICN) ;Print stand alone Primary View display
- +1 IF '$DATA(^XTMP("RGPVMPI"_ICN,"DATA"))
- WRITE !," - No MPI Primary View data exists for this patient."
- QUIT
- +2 NEW STATUS,R,RETURN,RESULT,RET
- +3 IF $DATA(^XTMP("RGPVMPI"_ICN,"DATA"))
- SET RETURN(0)=$PIECE(^XTMP("RGPVMPI"_ICN,"DATA"),"^")
- Begin DoDot:1
- +4 DO RPCCHK^XWB2HL7(.RESULT,RETURN(0))
- IF +RESULT(0)=1
- Begin DoDot:2
- +5 ;Retrieve the data
- +6 DO RTNDATA^XWBDRPC(.RET,RETURN(0))
- Begin DoDot:3
- +7 IF $DATA(RET(0))
- IF RET(0)<0
- WRITE !!,"No data returned due to: "_$PIECE(RET(0),"^",2)
- QUIT
- +8 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
- +9 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
- if 'Y
- QUIT
- WRITE @IOF
- SET $Y=1
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +10 QUIT
- +11 ;