GMRCISEG ;SLC/JFR - CREATE IFC HL7 SEGMENTS ; 7/26/01 22:15
 ;;3.0;CONSULT/REQUEST TRACKING;**22**;DEC 27, 1997
 Q  ;don't enter at top
BUILD(SEG,PCS) ;create any segment from array in PCS using |^&/~
 ; SEG = ORC,OBR,etc.
 ; PCS = array of data elements to be combined into the segement
 ;       array is numbered by the "|" piece 
 N ARR,SEGMNT
 S ARR=0,SEGMNT=""
 F  S ARR=$O(PCS(ARR)) Q:'ARR  D
 . S $P(SEGMNT,"|",ARR)=PCS(ARR)
 . Q
 Q SEG_"|"_SEGMNT
ORC(GMRCO,GMRCOC,GMRCOS,GMRCACT)    ;build ORC for all but new orders
 ;Input:
 ; GMRCO = ien from file 123
 ; GMRCOC = order control
 ; GMRCOS = order status
 ; GMRCACT = ien in 40 multiple of particular action
 ;
 ;Output: 
 ; ORC segment
 ;
 I '$D(GMRCO)!('$D(GMRCOC))!('$D(GMRCACT)) Q "ERROR"
 N GMRCPCS,SITE,GMRCRP
 S GMRCPCS(1)=GMRCOC
 I $P($G(^GMR(123,GMRCO,12)),U,5)="P" D
 . S GMRCPCS(2)=GMRCO_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_"^GMRCIFR"
 . S GMRCPCS(3)=$P(^GMR(123,GMRCO,0),U,22)_U_$$STA^XUAF4($P(^(0),U,23))
 . S GMRCPCS(3)=GMRCPCS(3)_"^GMRCIFC"
 I $P($G(^GMR(123,GMRCO,12)),U,5)="F" D
 . S GMRCPCS(2)=$P(^GMR(123,GMRCO,0),U,22)_U_$$STA^XUAF4($P(^(0),U,23))
 . S GMRCPCS(2)=GMRCPCS(2)_"^GMRCIFR"
 . S GMRCPCS(3)=GMRCO_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_"^GMRCIFC"
 S GMRCPCS(5)=$S($D(GMRCOS):GMRCOS,1:"")
 I GMRCOC["X" S $P(GMRCPCS(7),U,6)=$$URG^GMRCIUTL(GMRCO)
 S GMRCPCS(9)=$$FMTHL7^XLFDT($P(^GMR(123,GMRCO,40,GMRCACT,0),U,1))
 S GMRCPCS(10)=$$HLNAME^GMRCIUTL($P(^GMR(123,GMRCO,40,GMRCACT,0),U,5))
 S GMRCRP=$P(^GMR(123,GMRCO,40,GMRCACT,0),U,4) I +GMRCRP D
 . S GMRCPCS(12)=$$HLNAME^GMRCIUTL(GMRCRP)
 . N GMRCPHN,GMRCPAG
 . S GMRCPHN=$$GET1^DIQ(200,GMRCRP,.132)
 . S GMRCPAG=$$GET1^DIQ(200,GMRCRP,.138)
 . S GMRCPCS(14)=$$HLPHONE^HLFNC(GMRCPHN,GMRCPAG)
 S GMRCPCS(15)=$$FMTHL7^XLFDT($P(^GMR(123,GMRCO,40,GMRCACT,0),U,3))
 I GMRCOC["X"!(GMRCOC="SC")!(GMRCOC="RE") D 
 . I GMRCOC="XX" D  Q
 .. I $P(^GMR(123,GMRCO,40,GMRCACT,0),U,2)=25 D  Q
 ... S GMRCPCS(16)="FI^FORWARD TO IFC^99GMRC"
 .. S GMRCPCS(16)="F^FORWARD^99GMRC"
 . I GMRCOC="XO" S GMRCPCS(16)="E^EDIT-RESUBMIT^99GMRC" Q
 . I GMRCOC="SC" D  Q
 .. I GMRCOS="IP" S GMRCPCS(16)="R^RECEIVE^99GMRC"
 .. I GMRCOS="SC"  S GMRCPCS(16)="SC^SCHEDULE^99GMRC"
 . I GMRCOC="RE" D
 .. N ACTVT S ACTVT=$P(^GMR(123,GMRCO,40,GMRCACT,0),U,2)
 .. I ACTVT=12 S GMRCPCS(16)="D^DISASSOCIATE RESULT^99GMRC"
 .. I ACTVT=13 S GMRCPCS(16)="A^ADDENDUM^99GMRC"
 .. I ACTVT=4 S GMRCPCS(16)="S^SIGNIFICANT FINDING^99GMRC"
 . Q
 S SITE=$$SITE^VASITE
 I +SITE S GMRCPCS(17)=$P(SITE,U,3)_U_$P(SITE,U,2) ;use loc instead? ;-(
 Q $$BUILD^GMRCISEG("ORC",.GMRCPCS)
 ;
OBXWP(GMRCO,GMRCOC,GMRCACT,GMRCSEG) ; return a WP field in OBX segs
 ; Input:
 ;  GMRCO   = 
 ;  GMRCOC  =
 ;  GMRCACT = activity in 40 mult triggering msg
 ;  GMRCSEG = GLOBAL array to return results in
 ;
 ; Output:
 ;  ARRAY(1)=OBX|1|TX|coding scheme|1|text||||||obs result status
 ;  ARRAY(2)=OBX|1|TX|coding scheme|2|text||||||obs result status
 ;
 K ^TMP("GMRCWP",$J)
 N GMRCPCS
 I GMRCOC="NW"!(GMRCOC="XO") D  Q
 . N SUBS S SUBS=0
 . F  S SUBS=$O(^GMR(123,GMRCO,20,SUBS)) Q:'SUBS  D
 .. S GMRCPCS(1)=1,GMRCPCS(2)="TX"
 .. S GMRCPCS(3)="2000.02^REASON FOR REQUEST^AS4",GMRCPCS(4)=SUBS
 .. S GMRCPCS(5)=$G(^GMR(123,GMRCO,20,SUBS,0)),GMRCPCS(11)="O"
 .. S ^TMP("GMRCWP",$J,SUBS)=$$BUILD^GMRCISEG("OBX",.GMRCPCS)
 . M @GMRCSEG=^TMP("GMRCWP",$J)
 . K ^TMP("GMRCWP",$J)
 . Q
 I '$D(GMRCACT)!('$D(^GMR(123,GMRCO,40,GMRCACT,1))) Q
 N CMT,ACTVT
 S CMT=0,ACTVT=$P(^GMR(123,GMRCO,40,GMRCACT,0),U,2)
 F  S CMT=$O(^GMR(123,GMRCO,40,GMRCACT,1,CMT)) Q:'CMT  D
 . S GMRCPCS(1)=3,GMRCPCS(2)="TX"
 . S GMRCPCS(3)="^COMMENTS^",GMRCPCS(4)=CMT
 . S GMRCPCS(5)=$G(^GMR(123,GMRCO,40,GMRCACT,1,CMT,0))
 . S GMRCPCS(11)=$S(ACTVT=10:"F",1:"P") ;F if an admin comp. else "P"
 . S ^TMP("GMRCWP",$J,CMT)=$$BUILD^GMRCISEG("OBX",.GMRCPCS)
 M @GMRCSEG=^TMP("GMRCWP",$J)
 K ^TMP("GMRCWP",$J)
 Q
 ;
OBXRSLT(GMRCO,GMRCACT) ; build an OBX segment to send a TIU doc reference
 ; Input:
 ;  GMRCO   = ien from file 123
 ;  GMRCACT = activity entry in 40 multiple
 ;
 ; Output:
 ;  OBX segment 
 ;    e.g. OBX|4|RP|^TIU DOC^VA8925||41320^TIU^660||||||||F
 ;
 Q:'$D(^GMR(123,GMRCO,40,GMRCACT)) ""
 N GMRCPCS,RSLT,GMRCACTV
 S GMRCPCS(1)=4,GMRCPCS(2)="RP"
 S GMRCPCS(4)=1
 S GMRCACTV=$P(^GMR(123,GMRCO,40,GMRCACT,0),U,2)
 S RSLT=$P(^GMR(123,GMRCO,40,GMRCACT,0),U,9)
 I RSLT["TIU" D
 . S GMRCPCS(3)="^TIU DOC^VA8925"
 . S GMRCPCS(5)=+RSLT_"^TIU DOCUMENT^"_$$STA^XUAF4($$KSP^XUPARAM("INST"))
 I RSLT["MCAR" D
 . N MCPRNM S MCPRNM=$P($$SINGLE^MCAPI(RSLT),U)
 . S GMRCPCS(3)="^MED RSLT^VA"_+$P(RSLT,"MCAR(",2)
 . S GMRCPCS(5)=+RSLT_U_MCPRNM_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))
 S GMRCPCS(11)=$S(GMRCACTV=9:"S",GMRCACTV=12:"D",1:"F")
 Q $$BUILD^GMRCISEG("OBX",.GMRCPCS)
 ;
NTE(GMRCO,GMRCACT,GMRCAR) ;format an NTE seg with DC comment
 ; Input:
 ;  GMRCO   = ien from file 123
 ;  GMRCACT = activity entry in 40 multiple
 ;  GMRCAR  = array in which to pass back NTE segs 
 ;
 ; Output:
 ;  array of NTE segments containing the comment
 ;   e.g. NTE|1|L|cancelled by requestor
 ;
 Q:'$D(^GMR(123,GMRCO,40,GMRCACT,1))
 N CMT,GMRCPCS S CMT=0
 F  S CMT=$O(^GMR(123,GMRCO,40,GMRCACT,1,CMT)) Q:'CMT  D
 . S GMRCPCS(1)=CMT,GMRCPCS(2)="L"
 . S GMRCPCS(3)=$G(^GMR(123,GMRCO,40,GMRCACT,1,CMT,0))
 . S GMRCAR(CMT)=$$BUILD^GMRCISEG("NTE",.GMRCPCS)
 Q
 ;
MSA(GMRCAC,GMRCMSG,GMRCERR) ; build MSA for response to placer activity
 ; Input:
 ;  GMRCAC  = acknowledgment code  (AA or AR)
 ;  GMRCMSG = message number from incoming msg being responded to
 ;  GMRCERR = error message if can't accept the activity
 ;
 ; Output:
 ;  MSA segment to include with ACK or NAK
 ;
 N GMRCPCS
 S GMRCPCS(1)=GMRCAC
 S GMRCPCS(2)=GMRCMSG
 S GMRCPCS(3)=$G(GMRCERR)
 Q $$BUILD^GMRCISEG("MSA",.GMRCPCS)
 ;
OBXTZ() ;build and return an OBX with the current TIME ZONE encoded
 ;Input:
 ;  none
 ;
 ;Output:
 ;  OBX segment in the format:
 ;    OBX|5|CE|^TIME ZONE^VA4.4|1|MST||||||O
 ;
 N GMRCPCS
 S GMRCPCS(1)=5,GMRCPCS(2)="CE"
 S GMRCPCS(3)="^TIME ZONE^VA4.4",GMRCPCS(4)=1
 S GMRCPCS(5)=$$GET1^DIQ(4.3,1,1)
 Q $$BUILD^GMRCISEG("OBX",.GMRCPCS)
 ;
OBXSF(GMRCO) ; build OBX seg for Sig. Find.
 ; Input:
 ;  GMRCO = ien from file 123
 ;
 ; Output:
 ;   OBX segment in format:
 ;     OBX|6|TX|^SIG FINDINGS^|1|S||||||O
 ;
 I '$L($P(^GMR(123,GMRCO,0),U,19)) Q ""
 N GMRCPCS
 S GMRCPCS(1)=6,GMRCPCS(2)="TX",GMRCPCS(3)="^SIG FINDINGS^"
 S GMRCPCS(4)=1,GMRCPCS(5)=$P(^GMR(123,GMRCO,0),U,19),GMRCPCS(11)="O"
 Q $$BUILD^GMRCISEG("OBX",.GMRCPCS)