RGRSPAR2 ;ALB/RJS-SENSITIVITY MESSAGE PARSER FOR CIRN ;1/8/98
;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99
EN(ARRAY) ;
;This procedure returns specific patient information into a supplied
;variable
;
;Input: Required Variable
;
; ARRAY - Supplied array variable (Passed by reference)
;
;Output: from segments built from the PATIENT file (#2) of sending site
;
; ARRAY(.01) - .01 field in PATIENT file (#2)
; ARRAY(.02) - .02 field in PATIENT file (#2)
; ARRAY(.03) - .03 field in PATIENT file (#2)
; ARRAY(.09) - .09 field in PATIENT file (#2)
; ARRAY(991.01) - 991.01 field in PATIENT file (#2)
; ARRAY(991.02) - 991.02 field in PATIENT file (#2)
; ARRAY(991.03) - 991.03 field in PATIENT file (#2)
; ARRAY("SENDING SITE") - sending sites station number
; ARRAY("SENSITIVITY") - sensitivity of the patient at sending site
; ARRAY("SENSITIVITY USER") - user at sending site that make patient
; ARRAY("SENSITIVITY DATE") - date when patient was marked sensitive
;
N RGRSPID,RGC,RGRSPD1,SUBCOMP
S RGC=$E(HL("ECH")),SUBCOMP=$E(HL("ECH"),2)
S RGRSMSH=$$SEG1^RGRSUTIL("MSH",1,"MSH")
S RGRSPID=$$SEG1^RGRSUTIL("PID",1,"PID")
S RGRSPD1=$$SEG1^RGRSUTIL("PD1",1,"PD1")
S RGRSZSN=$$SEG1^RGRSUTIL("ZSN",1,"ZSN")
S @ARRAY@(.01)=$$FREE($$FMNAME^HLFNC($P(RGRSPID,HL("FS"),6),HL("ECH"))) ;NAME
S @ARRAY@(.02)=$$SEX($P(RGRSPID,HL("FS"),9)) ;SEX
S @ARRAY@(.03)=$$FREE($$FMDATE^HLFNC($P(RGRSPID,HL("FS"),8))) ;DOB
S @ARRAY@(.09)=$$FREE($P(RGRSPID,HL("FS"),20)) ;SOCIAL SECURITY #
S @ARRAY@(991.01)=$$FREE($P($P(RGRSPID,HL("FS"),3),"V",1)) ;INTEG CONTROL #
S @ARRAY@(991.02)=$$FREE($P($P(RGRSPID,HL("FS"),3),"V",2)) ;CHECKSUM
S @ARRAY@(991.03)=$$FREE($P($P(RGRSPD1,HL("FS"),4),RGC,1)) ;VCCI
S @ARRAY@("SITENUM")=$$FREE($P($P(RGRSPD1,HL("FS"),4),RGC,3)) ;VCCI SITENUM
S @ARRAY@("SENDING SITE")=$$FREE($P(RGRSMSH,HL("FS"),4)) ;SENDING SITE
S @ARRAY@("SENSITIVITY")=$$FREE($P(RGRSZSN,HL("FS"),2)) ;SENSTIVITY
S @ARRAY@("SENSITIVITY USER")=$$FREE($P(RGRSZSN,HL("FS"),3)) ;REMOTE PERSON WHO MADE PT. SENSITIVE
S @ARRAY@("SENSITIVITY DATE")=$$FREE($$FMDATE^HLFNC($P(RGRSZSN,HL("FS"),4))) ;DATE/TIME PERSON MADE PT. SENSITIVE AT REMOTE SITE
Q
;
KILL ;
K @ARRAY
Q
;
FREE(DATA) ;
Q:$G(DATA)="" ""
Q:DATA=HL("Q") """@"""
Q $G(DATA)
;
SEX(DATA) ;
Q:$$FREE(DATA)="" ""
Q:$$FREE(DATA)="""@""" """@"""
I DATA="M" Q "MALE"
I DATA="F" Q "FEMALE"
Q "^<UNRESOLVED>"
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGRSPAR2 2463 printed Sep 23, 2025@19:18:56 Page 2
RGRSPAR2 ;ALB/RJS-SENSITIVITY MESSAGE PARSER FOR CIRN ;1/8/98
+1 ;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99
EN(ARRAY) ;
+1 ;This procedure returns specific patient information into a supplied
+2 ;variable
+3 ;
+4 ;Input: Required Variable
+5 ;
+6 ; ARRAY - Supplied array variable (Passed by reference)
+7 ;
+8 ;Output: from segments built from the PATIENT file (#2) of sending site
+9 ;
+10 ; ARRAY(.01) - .01 field in PATIENT file (#2)
+11 ; ARRAY(.02) - .02 field in PATIENT file (#2)
+12 ; ARRAY(.03) - .03 field in PATIENT file (#2)
+13 ; ARRAY(.09) - .09 field in PATIENT file (#2)
+14 ; ARRAY(991.01) - 991.01 field in PATIENT file (#2)
+15 ; ARRAY(991.02) - 991.02 field in PATIENT file (#2)
+16 ; ARRAY(991.03) - 991.03 field in PATIENT file (#2)
+17 ; ARRAY("SENDING SITE") - sending sites station number
+18 ; ARRAY("SENSITIVITY") - sensitivity of the patient at sending site
+19 ; ARRAY("SENSITIVITY USER") - user at sending site that make patient
+20 ; ARRAY("SENSITIVITY DATE") - date when patient was marked sensitive
+21 ;
+22 NEW RGRSPID,RGC,RGRSPD1,SUBCOMP
+23 SET RGC=$EXTRACT(HL("ECH"))
SET SUBCOMP=$EXTRACT(HL("ECH"),2)
+24 SET RGRSMSH=$$SEG1^RGRSUTIL("MSH",1,"MSH")
+25 SET RGRSPID=$$SEG1^RGRSUTIL("PID",1,"PID")
+26 SET RGRSPD1=$$SEG1^RGRSUTIL("PD1",1,"PD1")
+27 SET RGRSZSN=$$SEG1^RGRSUTIL("ZSN",1,"ZSN")
+28 ;NAME
SET @ARRAY@(.01)=$$FREE($$FMNAME^HLFNC($PIECE(RGRSPID,HL("FS"),6),HL("ECH")))
+29 ;SEX
SET @ARRAY@(.02)=$$SEX($PIECE(RGRSPID,HL("FS"),9))
+30 ;DOB
SET @ARRAY@(.03)=$$FREE($$FMDATE^HLFNC($PIECE(RGRSPID,HL("FS"),8)))
+31 ;SOCIAL SECURITY #
SET @ARRAY@(.09)=$$FREE($PIECE(RGRSPID,HL("FS"),20))
+32 ;INTEG CONTROL #
SET @ARRAY@(991.01)=$$FREE($PIECE($PIECE(RGRSPID,HL("FS"),3),"V",1))
+33 ;CHECKSUM
SET @ARRAY@(991.02)=$$FREE($PIECE($PIECE(RGRSPID,HL("FS"),3),"V",2))
+34 ;VCCI
SET @ARRAY@(991.03)=$$FREE($PIECE($PIECE(RGRSPD1,HL("FS"),4),RGC,1))
+35 ;VCCI SITENUM
SET @ARRAY@("SITENUM")=$$FREE($PIECE($PIECE(RGRSPD1,HL("FS"),4),RGC,3))
+36 ;SENDING SITE
SET @ARRAY@("SENDING SITE")=$$FREE($PIECE(RGRSMSH,HL("FS"),4))
+37 ;SENSTIVITY
SET @ARRAY@("SENSITIVITY")=$$FREE($PIECE(RGRSZSN,HL("FS"),2))
+38 ;REMOTE PERSON WHO MADE PT. SENSITIVE
SET @ARRAY@("SENSITIVITY USER")=$$FREE($PIECE(RGRSZSN,HL("FS"),3))
+39 ;DATE/TIME PERSON MADE PT. SENSITIVE AT REMOTE SITE
SET @ARRAY@("SENSITIVITY DATE")=$$FREE($$FMDATE^HLFNC($PIECE(RGRSZSN,HL("FS"),4)))
+40 QUIT
+41 ;
KILL ;
+1 KILL @ARRAY
+2 QUIT
+3 ;
FREE(DATA) ;
+1 if $GET(DATA)=""
QUIT ""
+2 if DATA=HL("Q")
QUIT """@"""
+3 QUIT $GET(DATA)
+4 ;
SEX(DATA) ;
+1 if $$FREE(DATA)=""
QUIT ""
+2 if $$FREE(DATA)="""@"""
QUIT """@"""
+3 IF DATA="M"
QUIT "MALE"
+4 IF DATA="F"
QUIT "FEMALE"
+5 QUIT "^<UNRESOLVED>"
+6 ;
