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