Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRCISEG

GMRCISEG.m

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