- 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 ;
