RGRSPAR2.m

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 ---RGRSPAR2   2463     printed  Apr 09, 2024@20:48                                                                                                                                                                                                       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       ;