Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed
  • WorldVistAEHR/trunk/r/CLINICAL_INFO_RESOURCE_NETWORK-MRF-RGE--RG--RGED--RGUT--RGWB/RGEX06.m

    r613 r623  
    1 RGEX06  ;BIR/PTD-LIST MANAGER ROUTINE FOR REMOTE MPI PRIMARY VIEW PDAT ;5/17/07
    2         ;;1.0;CLINICAL INFO RESOURCE NETWORK;**48,53**;30 Apr 99;Build 2
    3         ;
    4         ;Reference to ^XWB2HL7 supported by IA #3144
    5         ;Reference to ^XWBDRPC supported by IA #3149
    6         ;
    7 EN(ICN) ;Entry point calling List Template for primary view PDAT display
    8         D EN^VALM("RG EXCPT PV MPI PDAT")
    9         Q
    10         ;
    11 HDR     ; -- header code
    12         S VALMHDR(1)="MPI PRIMARY VIEW PATIENT DATA DISPLAY"
    13         Q
    14         ;
    15 INIT    ;Display the MPI Primary View Patient Data (PDAT)
    16         K ^TMP("RGEXC6",$J)
    17         K @VALMAR
    18         I '$D(ICN) G EXIT
    19         S LIN=1,X=0,STR="",TXT=""
    20         I '$D(^XTMP("RGPVMPI"_ICN,"DATA")) S TXT=" - No MPI Primary View data exists for this patient." D ADDTMP
    21         N STATUS,R,RETURN,RESULT,RET
    22         I $D(^XTMP("RGPVMPI"_ICN,"DATA")) S RETURN(0)=$P(^XTMP("RGPVMPI"_ICN,"DATA"),"^") D
    23         .D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) I +RESULT(0)=1 D
    24         ..;Retrieve the data
    25         ..D RTNDATA^XWBDRPC(.RET,RETURN(0)) D
    26         ...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
    27         ...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
    28         ...S R="" F  S R=$O(RET(R)) Q:R=""  S TXT=RET(R) S STR=$$SETSTR^VALM1(TXT,STR,1,80) D ADDTMP
    29         K GLO,L,R,SL
    30         S VALMCNT=LIN-1
    31         Q
    32         ;
    33 ADDTMP  ;Set string into the array.
    34         S ^TMP("RGEXC6",$J,LIN,0)=STR
    35         S ^TMP("RGEXC6",$J,"IDX",LIN,LIN)=""
    36         S LIN=LIN+1,STR=""
    37         Q
    38         ;
    39 HELP    ; -- help code
    40         S X="?" D DISP^XQORM1 W !!
    41         Q
    42         ;
    43 EXIT    ; -- exit code
    44         S VALMBCK=""
    45         K ^TMP("RGEXC6",$J),GLO,L,LIN,R,RESULT,RET,RETURN,SL,STATUS,STR,TXT,X
    46         S VALMBCK="R"
    47         Q
    48         ;
    49 EXPND   ; -- expand code
    50         Q
    51         ;
    52 SAPV(ICN)       ;Print stand alone Primary View display
    53         I '$D(^XTMP("RGPVMPI"_ICN,"DATA")) W !," - No MPI Primary View data exists for this patient." Q
    54         N STATUS,R,RETURN,RESULT,RET
    55         I $D(^XTMP("RGPVMPI"_ICN,"DATA")) S RETURN(0)=$P(^XTMP("RGPVMPI"_ICN,"DATA"),"^") D
    56         .D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) I +RESULT(0)=1 D
    57         ..;Retrieve the data
    58         ..D RTNDATA^XWBDRPC(.RET,RETURN(0)) D
    59         ...I $D(RET(0)) I RET(0)<0 W !!,"No data returned due to: "_$P(RET(0),"^",2) Q
    60         ...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
    61         ...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
    62         Q
    63         ;
     1RGEX06 ;BIR/PTD-LIST MANAGER ROUTINE FOR REMOTE MPI PRIMARY VIEW PDAT ;5/17/07
     2 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**48**;30 Apr 99;Build 3
     3 ;
     4 ;Reference to ^XWB2HL7 supported by IA #3144
     5 ;Reference to ^XWBDRPC supported by IA #3149
     6 ;
     7EN(ICN) ;Entry point calling List Template for primary view PDAT display
     8 D EN^VALM("RG EXCPT PV MPI PDAT")
     9 Q
     10 ;
     11HDR ; -- header code
     12 S VALMHDR(1)="MPI PRIMARY VIEW PATIENT DATA DISPLAY"
     13 Q
     14 ;
     15INIT ;Display the MPI Primary View Patient Data (PDAT)
     16 K ^TMP("RGEXC6",$J)
     17 K @VALMAR
     18 I '$D(ICN) G EXIT
     19 S LIN=1,X=0,STR="",TXT=""
     20 I '$D(^XTMP("RGPVMPI",ICN)) S TXT=" - No MPI Primary View data exists for this patient." D ADDTMP
     21 N STATUS,R,RETURN,RESULT,RET
     22 I $D(^XTMP("RGPVMPI",ICN)) S RETURN(0)=$P(^XTMP("RGPVMPI",ICN),"^") D
     23 .D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) I +RESULT(0)=1 D
     24 ..;Retrieve the data
     25 ..D RTNDATA^XWBDRPC(.RET,RETURN(0)) D
     26 ...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
     27 ...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
     28 ...S R="" F  S R=$O(RET(R)) Q:R=""  S TXT=RET(R) S STR=$$SETSTR^VALM1(TXT,STR,1,80) D ADDTMP
     29 K GLO,L,R,SL
     30 S VALMCNT=LIN-1
     31 Q
     32 ;
     33ADDTMP ;Set string into the array.
     34 S ^TMP("RGEXC6",$J,LIN,0)=STR
     35 S ^TMP("RGEXC6",$J,"IDX",LIN,LIN)=""
     36 S LIN=LIN+1,STR=""
     37 Q
     38 ;
     39HELP ; -- help code
     40 S X="?" D DISP^XQORM1 W !!
     41 Q
     42 ;
     43EXIT ; -- exit code
     44 S VALMBCK=""
     45 K ^TMP("RGEXC6",$J),GLO,L,LIN,R,RESULT,RET,RETURN,SL,STATUS,STR,TXT,X
     46 S VALMBCK="R"
     47 Q
     48 ;
     49EXPND ; -- expand code
     50 Q
     51 ;
     52SAPV(ICN) ;Print stand alone Primary View display
     53 I '$D(^XTMP("RGPVMPI",ICN)) W !," - No MPI Primary View data exists for this patient." Q
     54 N STATUS,R,RETURN,RESULT,RET
     55 I $D(^XTMP("RGPVMPI",ICN)) S RETURN(0)=$P(^XTMP("RGPVMPI",ICN),"^") D
     56 .D RPCCHK^XWB2HL7(.RESULT,RETURN(0)) I +RESULT(0)=1 D
     57 ..;Retrieve the data
     58 ..D RTNDATA^XWBDRPC(.RET,RETURN(0)) D
     59 ...I $D(RET(0)) I RET(0)<0 W !!,"No data returned due to: "_$P(RET(0),"^",2) Q
     60 ...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
     61 ...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
     62 Q
     63 ;
Note: See TracChangeset for help on using the changeset viewer.