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 ---[H[J[2J[HRGRSPAR1 803 printed Dec 13, 2024@01:42:56 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
