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 Dec 13, 2024@01:41:45 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 ;
