GMRCISG1 ;SLC/JFR - BUILD IFC HL7 SEGMENTS CONT'D ;10/31/01 09:00
;;3.0;CONSULT/REQUEST TRACKING;**22**;DEC 27, 1997
Q ;can't start here
ORCRESP(GMRCO,GMRCOC,GMRCOS) ;build ORC for app ACK msgs
; Input:
; GMRCO = ien from file 123 of entry responding to
; GMRCOC = order control to put into segment
; GMRCOS = HL7 encoded order status to put in message
;
; Output:
; ORC segment to use in response message
;
N GMRCPCS,SITE
S GMRCPCS(1)=GMRCOC
S GMRCPCS(2)=$P(^GMR(123,GMRCO,0),U,22)_U_$$STA^XUAF4($P(^(0),U,23))_"^GMRCIFR"
S GMRCPCS(3)=GMRCO_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_"^GMRCIFC"
S GMRCPCS(5)=$G(GMRCOS)
S GMRCPCS(17)=$$STA^XUAF4($$KSP^XUPARAM("INST"))
Q $$BUILD^GMRCISEG("ORC",.GMRCPCS)
;
NWORC(GMRCO) ; build ORC seg for a new order
; Input:
; GMRCO = ien from file 123 of order to send remotely
;
; Output:
; ORC segment to send with a new order to remote facility
;
N GMRCPCS,SITE,GMRCPHN,GMRCPAG
S GMRCPCS(1)="NW"
S GMRCPCS(2)=GMRCO_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_U_"GMRCIFR"
S $P(GMRCPCS(7),U,6)=$$URG^GMRCIUTL(GMRCO)
S GMRCPCS(9)=$$FMTHL7^XLFDT(+^GMR(123,GMRCO,0))
S GMRCPCS(10)=$$HLNAME^GMRCIUTL($P($G(^GMR(123,GMRCO,40,1,0)),U,5))
S GMRCPCS(12)=$$HLNAME^GMRCIUTL($P(^GMR(123,GMRCO,0),U,14))
S GMRCPHN=$$GET1^DIQ(200,$P(^GMR(123,GMRCO,0),U,14),.132)
S GMRCPAG=$$GET1^DIQ(200,$P(^GMR(123,GMRCO,0),U,14),.138)
S GMRCPCS(14)=$$HLPHONE^HLFNC(GMRCPHN,GMRCPAG)
S GMRCPCS(15)=$$FMTHL7^XLFDT($P(^GMR(123,GMRCO,0),U,7))
I $O(^GMR(123,GMRCO,40,1)) D
. N I,ACTV S I=1
. F S I=$O(^GMR(123,GMRCO,40,I)) Q:'I S ACTV=$P(^(I,0),U,2) D
.. I ACTV'=25 Q
.. S GMRCPCS(16)="FI^FORWARD TO IFC^99GMRC"
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)
OBXPD(GMRCO) ; create OBX segment for the prov. dx
; Input:
; GMRCO = ien from file 123 of order to send remotely
;
; Output:
; OBX segment containing the Provisional Diagnosis
;
Q:'$L($G(^GMR(123,GMRCO,30))) ""
N GMRCPCS
S GMRCPCS(1)=2,GMRCPCS(2)=$S($L($G(^GMR(123,GMRCO,30.1))):"CE",1:"TX")
S GMRCPCS(3)="^PROVISIONAL DIAGNOSIS^",GMRCPCS(4)=1
S GMRCPCS(11)="O"
I $L($G(^GMR(123,GMRCO,30.1))) D Q $$BUILD^GMRCISEG("OBX",.GMRCPCS)
. ;coded diagnosis
. S GMRCPCS(5)=$G(^GMR(123,GMRCO,30.1))_U_$G(^(30))_U_"I9C"
S GMRCPCS(5)=U_$G(^GMR(123,GMRCO,30))_U ;free text dx
Q $$BUILD^GMRCISEG("OBX",.GMRCPCS)
;
OBR(GMRCO,GMRCACT) ; build an OBR seg for new order or resubmit
; Input:
; GMRCO = ien from file 123
; GMRCACT = ien from 40 multiple of action (only on resubmit or fwd)
;
; Output:
; OBR segment
;
N GMRCPCS,GMRCROL
S GMRCPCS(1)=1
S GMRCROL=$P(^GMR(123,GMRCO,12),U,5)
I GMRCROL="P" D
. S GMRCPCS(2)=GMRCO_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_U_"GMRCIFR"
I $D(GMRCACT) D ; resubmit sends filler # too
. I GMRCROL="P" D
.. S GMRCPCS(3)=$P(^GMR(123,GMRCO,0),U,22)_U_$$STA^XUAF4($P(^(0),U,23))
.. S GMRCPCS(3)=GMRCPCS(3)_U_"GMRCIFC"
. I GMRCROL="F" D
.. S GMRCPCS(2)=$P(^GMR(123,GMRCO,0),U,22)_U_$$STA^XUAF4($P(^(0),U,23))
.. S GMRCPCS(2)=GMRCPCS(2)_U_"GMRCIFR"
.. S GMRCPCS(3)=GMRCO_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_U_"GMRCIFC"
I $D(GMRCACT),$P(^GMR(123,GMRCO,40,GMRCACT,0),U,2)=17 D
. ;FWD uses txt of current svc
. N SITE,SERVNM,SERV
. S SITE=$$STA^XUAF4($$KSP^XUPARAM("INST"))_"VA1235"
. I GMRCROL="F" S SERV=$P(^GMR(123,GMRCO,0),U,5)
. I GMRCROL="P" S SERV=$P(^GMR(123,GMRCO,40,GMRCACT,0),U,6)
. S SERVNM=$S(+SERV:$P(^GMR(123.5,SERV,0),U),1:"")
. S GMRCPCS(4)=SERV_U_SERVNM_U_SITE
I $D(GMRCACT),$P(^GMR(123,GMRCO,40,GMRCACT,0),U,2)=25 D
. ;FWD to IFC uses the FORWARDED FROM service name
. N SITE,SERVNM,SERV
. S SITE=$$STA^XUAF4($$KSP^XUPARAM("INST"))_"VA1235"
. S SERV=$P(^GMR(123,GMRCO,40,GMRCACT,0),U,6)
. I '+SERV Q
. S SERVNM=$P(^GMR(123.5,SERV,0),U)
. S GMRCPCS(4)=SERV_U_SERVNM_U_SITE
I '$D(GMRCPCS(4)) D
. S GMRCPCS(4)=$$CODEOI^GMRCIUTL(GMRCO) ;get remote service or proc
I $D(GMRCACT) D ;resubmit or fwd so use activity fields for msg
. S GMRCPCS(6)=$$FMTHL7^XLFDT($P(^GMR(123,GMRCO,40,GMRCACT,0),U,3))
. S GMRCPCS(16)=$$HLNAME^GMRCIUTL($P(^GMR(123,GMRCO,40,GMRCACT,0),U,4))
I '$D(GMRCACT) D ; new order being sent
. S GMRCPCS(6)=$$FMTHL7^XLFDT($P(^GMR(123,GMRCO,0),U,7))
. S GMRCPCS(16)=$$HLNAME^GMRCIUTL($P(^GMR(123,GMRCO,0),U,14))
S GMRCPCS(18)=$P(^GMR(123,GMRCO,0),U,18)
Q $$BUILD^GMRCISEG("OBR",.GMRCPCS)
;
ORCTST() ;build ORC for testing imp.
;Input:
;
;Output:
; ORC segment used to test IFC implementation
;
N GMRCPCS,SITE,GMRCRP
S GMRCPCS(1)="NW"
S GMRCPCS(2)="TST1234"_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_"^GMRCIFR"
S GMRCPCS(9)=$$FMTHL7^XLFDT($$NOW^XLFDT)
S GMRCPCS(10)="PUBLIC^JOHN^Q"
S GMRCPCS(16)="T^TESTING^99GMRC"
Q $$BUILD^GMRCISEG("ORC",.GMRCPCS)
;
;
OBRTST(GMRCOI,GMRCTYP) ; build OBR seg for testing imp.
; Input:
; GMRCOI = ien from file 123.5 or 123.3
; GMRCTYP = "P" or "C" (procedure or consult service)
;
; Output:
; OBR segment used to test implementation
;
N GMRCPCS,SITE
S SITE=$$STA^XUAF4($$KSP^XUPARAM("INST"))
S GMRCPCS(1)=1
S GMRCPCS(2)="TST1234"_U_SITE_"^GMRCIFR"
I GMRCTYP="C" D
. N SERV
. S SERV=$P(^GMR(123.5,GMRCOI,"IFC"),U,2)
. S GMRCPCS(4)=GMRCOI_U_SERV_U_SITE_"VA1235"
I GMRCTYP="P" D
. N PROC
. S PROC=$P(^GMR(123.3,GMRCOI,"IFC"),U,2)
. S GMRCPCS(4)=GMRCOI_U_PROC_U_SITE_"VA1233"
Q $$BUILD^GMRCISEG("OBR",.GMRCPCS)
;
GMRCISG1 ;SLC/JFR - BUILD IFC HL7 SEGMENTS CONT'D ;10/31/01 09:00
+1 ;;3.0;CONSULT/REQUEST TRACKING;**22**;DEC 27, 1997
+2 ;can't start here
QUIT
ORCRESP(GMRCO,GMRCOC,GMRCOS) ;build ORC for app ACK msgs
+1 ; Input:
+2 ; GMRCO = ien from file 123 of entry responding to
+3 ; GMRCOC = order control to put into segment
+4 ; GMRCOS = HL7 encoded order status to put in message
+5 ;
+6 ; Output:
+7 ; ORC segment to use in response message
+8 ;
+9 NEW GMRCPCS,SITE
+10 SET GMRCPCS(1)=GMRCOC
+11 SET GMRCPCS(2)=$PIECE(^GMR(123,GMRCO,0),U,22)_U_$$STA^XUAF4($PIECE(^(0),U,23))_"^GMRCIFR"
+12 SET GMRCPCS(3)=GMRCO_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_"^GMRCIFC"
+13 SET GMRCPCS(5)=$GET(GMRCOS)
+14 SET GMRCPCS(17)=$$STA^XUAF4($$KSP^XUPARAM("INST"))
+15 QUIT $$BUILD^GMRCISEG("ORC",.GMRCPCS)
+16 ;
NWORC(GMRCO) ; build ORC seg for a new order
+1 ; Input:
+2 ; GMRCO = ien from file 123 of order to send remotely
+3 ;
+4 ; Output:
+5 ; ORC segment to send with a new order to remote facility
+6 ;
+7 NEW GMRCPCS,SITE,GMRCPHN,GMRCPAG
+8 SET GMRCPCS(1)="NW"
+9 SET GMRCPCS(2)=GMRCO_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_U_"GMRCIFR"
+10 SET $PIECE(GMRCPCS(7),U,6)=$$URG^GMRCIUTL(GMRCO)
+11 SET GMRCPCS(9)=$$FMTHL7^XLFDT(+^GMR(123,GMRCO,0))
+12 SET GMRCPCS(10)=$$HLNAME^GMRCIUTL($PIECE($GET(^GMR(123,GMRCO,40,1,0)),U,5))
+13 SET GMRCPCS(12)=$$HLNAME^GMRCIUTL($PIECE(^GMR(123,GMRCO,0),U,14))
+14 SET GMRCPHN=$$GET1^DIQ(200,$PIECE(^GMR(123,GMRCO,0),U,14),.132)
+15 SET GMRCPAG=$$GET1^DIQ(200,$PIECE(^GMR(123,GMRCO,0),U,14),.138)
+16 SET GMRCPCS(14)=$$HLPHONE^HLFNC(GMRCPHN,GMRCPAG)
+17 SET GMRCPCS(15)=$$FMTHL7^XLFDT($PIECE(^GMR(123,GMRCO,0),U,7))
+18 IF $ORDER(^GMR(123,GMRCO,40,1))
Begin DoDot:1
+19 NEW I,ACTV
SET I=1
+20 FOR
SET I=$ORDER(^GMR(123,GMRCO,40,I))
IF 'I
QUIT
SET ACTV=$PIECE(^(I,0),U,2)
Begin DoDot:2
+21 IF ACTV'=25
QUIT
+22 SET GMRCPCS(16)="FI^FORWARD TO IFC^99GMRC"
End DoDot:2
End DoDot:1
+23 SET SITE=$$SITE^VASITE
+24 ;use loc instead? ;-(
IF +SITE
SET GMRCPCS(17)=$PIECE(SITE,U,3)_U_$PIECE(SITE,U,2)
+25 QUIT $$BUILD^GMRCISEG("ORC",.GMRCPCS)
OBXPD(GMRCO) ; create OBX segment for the prov. dx
+1 ; Input:
+2 ; GMRCO = ien from file 123 of order to send remotely
+3 ;
+4 ; Output:
+5 ; OBX segment containing the Provisional Diagnosis
+6 ;
+7 IF '$LENGTH($GET(^GMR(123,GMRCO,30)))
QUIT ""
+8 NEW GMRCPCS
+9 SET GMRCPCS(1)=2
SET GMRCPCS(2)=$SELECT($LENGTH($GET(^GMR(123,GMRCO,30.1))):"CE",1:"TX")
+10 SET GMRCPCS(3)="^PROVISIONAL DIAGNOSIS^"
SET GMRCPCS(4)=1
+11 SET GMRCPCS(11)="O"
+12 IF $LENGTH($GET(^GMR(123,GMRCO,30.1)))
Begin DoDot:1
+13 ;coded diagnosis
+14 SET GMRCPCS(5)=$GET(^GMR(123,GMRCO,30.1))_U_$GET(^(30))_U_"I9C"
End DoDot:1
QUIT $$BUILD^GMRCISEG("OBX",.GMRCPCS)
+15 ;free text dx
SET GMRCPCS(5)=U_$GET(^GMR(123,GMRCO,30))_U
+16 QUIT $$BUILD^GMRCISEG("OBX",.GMRCPCS)
+17 ;
OBR(GMRCO,GMRCACT) ; build an OBR seg for new order or resubmit
+1 ; Input:
+2 ; GMRCO = ien from file 123
+3 ; GMRCACT = ien from 40 multiple of action (only on resubmit or fwd)
+4 ;
+5 ; Output:
+6 ; OBR segment
+7 ;
+8 NEW GMRCPCS,GMRCROL
+9 SET GMRCPCS(1)=1
+10 SET GMRCROL=$PIECE(^GMR(123,GMRCO,12),U,5)
+11 IF GMRCROL="P"
Begin DoDot:1
+12 SET GMRCPCS(2)=GMRCO_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_U_"GMRCIFR"
End DoDot:1
+13 ; resubmit sends filler # too
IF $DATA(GMRCACT)
Begin DoDot:1
+14 IF GMRCROL="P"
Begin DoDot:2
+15 SET GMRCPCS(3)=$PIECE(^GMR(123,GMRCO,0),U,22)_U_$$STA^XUAF4($PIECE(^(0),U,23))
+16 SET GMRCPCS(3)=GMRCPCS(3)_U_"GMRCIFC"
End DoDot:2
+17 IF GMRCROL="F"
Begin DoDot:2
+18 SET GMRCPCS(2)=$PIECE(^GMR(123,GMRCO,0),U,22)_U_$$STA^XUAF4($PIECE(^(0),U,23))
+19 SET GMRCPCS(2)=GMRCPCS(2)_U_"GMRCIFR"
+20 SET GMRCPCS(3)=GMRCO_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_U_"GMRCIFC"
End DoDot:2
End DoDot:1
+21 IF $DATA(GMRCACT)
IF $PIECE(^GMR(123,GMRCO,40,GMRCACT,0),U,2)=17
Begin DoDot:1
+22 ;FWD uses txt of current svc
+23 NEW SITE,SERVNM,SERV
+24 SET SITE=$$STA^XUAF4($$KSP^XUPARAM("INST"))_"VA1235"
+25 IF GMRCROL="F"
SET SERV=$PIECE(^GMR(123,GMRCO,0),U,5)
+26 IF GMRCROL="P"
SET SERV=$PIECE(^GMR(123,GMRCO,40,GMRCACT,0),U,6)
+27 SET SERVNM=$SELECT(+SERV:$PIECE(^GMR(123.5,SERV,0),U),1:"")
+28 SET GMRCPCS(4)=SERV_U_SERVNM_U_SITE
End DoDot:1
+29 IF $DATA(GMRCACT)
IF $PIECE(^GMR(123,GMRCO,40,GMRCACT,0),U,2)=25
Begin DoDot:1
+30 ;FWD to IFC uses the FORWARDED FROM service name
+31 NEW SITE,SERVNM,SERV
+32 SET SITE=$$STA^XUAF4($$KSP^XUPARAM("INST"))_"VA1235"
+33 SET SERV=$PIECE(^GMR(123,GMRCO,40,GMRCACT,0),U,6)
+34 IF '+SERV
QUIT
+35 SET SERVNM=$PIECE(^GMR(123.5,SERV,0),U)
+36 SET GMRCPCS(4)=SERV_U_SERVNM_U_SITE
End DoDot:1
+37 IF '$DATA(GMRCPCS(4))
Begin DoDot:1
+38 ;get remote service or proc
SET GMRCPCS(4)=$$CODEOI^GMRCIUTL(GMRCO)
End DoDot:1
+39 ;resubmit or fwd so use activity fields for msg
IF $DATA(GMRCACT)
Begin DoDot:1
+40 SET GMRCPCS(6)=$$FMTHL7^XLFDT($PIECE(^GMR(123,GMRCO,40,GMRCACT,0),U,3))
+41 SET GMRCPCS(16)=$$HLNAME^GMRCIUTL($PIECE(^GMR(123,GMRCO,40,GMRCACT,0),U,4))
End DoDot:1
+42 ; new order being sent
IF '$DATA(GMRCACT)
Begin DoDot:1
+43 SET GMRCPCS(6)=$$FMTHL7^XLFDT($PIECE(^GMR(123,GMRCO,0),U,7))
+44 SET GMRCPCS(16)=$$HLNAME^GMRCIUTL($PIECE(^GMR(123,GMRCO,0),U,14))
End DoDot:1
+45 SET GMRCPCS(18)=$PIECE(^GMR(123,GMRCO,0),U,18)
+46 QUIT $$BUILD^GMRCISEG("OBR",.GMRCPCS)
+47 ;
ORCTST() ;build ORC for testing imp.
+1 ;Input:
+2 ;
+3 ;Output:
+4 ; ORC segment used to test IFC implementation
+5 ;
+6 NEW GMRCPCS,SITE,GMRCRP
+7 SET GMRCPCS(1)="NW"
+8 SET GMRCPCS(2)="TST1234"_U_$$STA^XUAF4($$KSP^XUPARAM("INST"))_"^GMRCIFR"
+9 SET GMRCPCS(9)=$$FMTHL7^XLFDT($$NOW^XLFDT)
+10 SET GMRCPCS(10)="PUBLIC^JOHN^Q"
+11 SET GMRCPCS(16)="T^TESTING^99GMRC"
+12 QUIT $$BUILD^GMRCISEG("ORC",.GMRCPCS)
+13 ;
+14 ;
OBRTST(GMRCOI,GMRCTYP) ; build OBR seg for testing imp.
+1 ; Input:
+2 ; GMRCOI = ien from file 123.5 or 123.3
+3 ; GMRCTYP = "P" or "C" (procedure or consult service)
+4 ;
+5 ; Output:
+6 ; OBR segment used to test implementation
+7 ;
+8 NEW GMRCPCS,SITE
+9 SET SITE=$$STA^XUAF4($$KSP^XUPARAM("INST"))
+10 SET GMRCPCS(1)=1
+11 SET GMRCPCS(2)="TST1234"_U_SITE_"^GMRCIFR"
+12 IF GMRCTYP="C"
Begin DoDot:1
+13 NEW SERV
+14 SET SERV=$PIECE(^GMR(123.5,GMRCOI,"IFC"),U,2)
+15 SET GMRCPCS(4)=GMRCOI_U_SERV_U_SITE_"VA1235"
End DoDot:1
+16 IF GMRCTYP="P"
Begin DoDot:1
+17 NEW PROC
+18 SET PROC=$PIECE(^GMR(123.3,GMRCOI,"IFC"),U,2)
+19 SET GMRCPCS(4)=GMRCOI_U_PROC_U_SITE_"VA1233"
End DoDot:1
+20 QUIT $$BUILD^GMRCISEG("OBR",.GMRCPCS)
+21 ;
