RGRSPAR1.m

RGRSPAR1 ;ALB/RJS-REGISTRATION MESSAGE PARSER FOR CIRN TFU ;6/9/97

 ;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99

EN(ARRAY) ;

 ;This procedure call updates a given array with CMOR site number and ICN

 ;

 ;Input: Required Variable

 ;

 ;  ARRAY - Supplied array variable (Passed by reference)

 ;

 ;Output:

 ;

 ;  ARRAY("SITENUM") - Patient's CMOR site number

 ;  ARRAY("ICN") - Patient's ICN 

 ;

 N RGRSMFI,RGRSMFE,RGC,SUBCOMP

 S RGC=$E(HL("ECH")),SUBCOMP=$E(HL("ECH"),2)

 S RGRSMFI=$$SEG1^RGRSUTIL("MFI",1,"MFI")

 S RGRSMFE=$$SEG1^RGRSUTIL("MFE",1,"MFE")

 S @ARRAY@("SITENUM")=$$FREE($P($P(RGRSMFE,HL("FS"),5),RGC,1)) ;VCCI SITENUM

 S @ARRAY@("ICN")=$$FREE($P($P(RGRSMFE,HL("FS"),5),RGC,4)) ;ICN

 Q

FREE(DATA)      ;

 Q:$G(DATA)="" ""

 Q:DATA=HL("Q") """@"""

 Q $G(DATA)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---RGRSPAR1   803     printed  Apr 09, 2024@20:46:47                                                                                                                                                                                                     Page 2

RGRSPAR1  ;ALB/RJS-REGISTRATION MESSAGE PARSER FOR CIRN TFU ;6/9/97

 +1       ;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99

EN(ARRAY) ;

 +1       ;This procedure call updates a given array with CMOR site number and ICN

 +2       ;

 +3       ;Input: Required Variable

 +4       ;

 +5       ;  ARRAY - Supplied array variable (Passed by reference)

 +6       ;

 +7       ;Output:

 +8       ;

 +9       ;  ARRAY("SITENUM") - Patient's CMOR site number

 +10      ;  ARRAY("ICN") - Patient's ICN 

 +11      ;

 +12       NEW RGRSMFI,RGRSMFE,RGC,SUBCOMP

 +13       SET RGC=$EXTRACT(HL("ECH"))

           SET SUBCOMP=$EXTRACT(HL("ECH"),2)

 +14       SET RGRSMFI=$$SEG1^RGRSUTIL("MFI",1,"MFI")

 +15       SET RGRSMFE=$$SEG1^RGRSUTIL("MFE",1,"MFE")

 +16      ;VCCI SITENUM

           SET @ARRAY@("SITENUM")=$$FREE($PIECE($PIECE(RGRSMFE,HL("FS"),5),RGC,1))

 +17      ;ICN

           SET @ARRAY@("ICN")=$$FREE($PIECE($PIECE(RGRSMFE,HL("FS"),5),RGC,4))

 +18       QUIT 

FREE(DATA) ;

 +1        if $GET(DATA)=""

               QUIT ""

 +2        if DATA=HL("Q")

               QUIT """@"""

 +3        QUIT $GET(DATA)

 +4        QUIT