| 1 | SRHLUO1 ;BIR/DLR - Surgery Interface (Cont.) Utilities for building Outgoing HL7 Segments ; [ 05/20/99 7:14 AM ]
|
---|
| 2 | ;;3.0; Surgery ;**41,88,127**;24 Jun 93
|
---|
| 3 | ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
---|
| 4 | ;INIT^HLTRANS MUST BE called before calling this routine.
|
---|
| 5 | ZCH(SRI,SREVENT,SRSTATUS,SRENT) ;sets ^TMP(SRENT,$J global for sending ZCH Scheduling Appointment Information segment(s)
|
---|
| 6 | N ADD,ADD1,ADDR,PHONE,SRJ,SRM,SRP,SRREP,SRX,XX,ZCH,SROERR
|
---|
| 7 | S (ZCH(1),ZCH(3))=HL("Q")
|
---|
| 8 | S ZCH(2)=CASE
|
---|
| 9 | ;eventid^text(STATUS)^coding scheme^...
|
---|
| 10 | S ZCH(4)=$G(SREVENT)_HLCOMP_$G(SRSTATUS)_HLCOMP_"L"
|
---|
| 11 | I $D(^SRF(CASE,"OP")) S ZCH(5)=$P($G(^("OP")),U,2) I ZCH(5)'="" D
|
---|
| 12 | .S SRX=$$CPT^ICPTCOD(ZCH(5),$P($G(^SRF(CASE,0)),"^",9)),ZCH(5)=$P(SRX,U,2)_HLCOMP_$P(SRX,U,3)_HLCOMP_"C4"
|
---|
| 13 | .S (SRJ,SRREP)=0 F S SRJ=$O(^SRF(CASE,"OPMOD",SRJ)) Q:'SRJ S SRP=$P(^SRF(CASE,"OPMOD",SRJ,0),U),SRM=$$MOD^ICPTMOD(SRP,"I",$P($G(^SRF(CASE,0)),U,9)) D
|
---|
| 14 | ..S ZCH(18)=$G(ZCH(18))_$S(SRREP:HLREP,1:"")_$P(SRM,U,2)_HLCOMP_$P(SRM,U,3)_HLCOMP,SRREP=1
|
---|
| 15 | I $G(ZCH(5))="" S ZCH(5)=HLCOMP_$P($G(^SRF(CASE,"OP")),U)
|
---|
| 16 | I $D(^SRF(CASE,".4")) S ZCH(6)=$P($G(^(.4)),U) I ZCH(6)'="" S ZCH(6)=($P(ZCH(6),":")*60)+($P($G(ZCH(6)),":",2))_HLCOMP_"min"
|
---|
| 17 | I $G(SRSTATUS)="(SCHEDULED)" D
|
---|
| 18 | .S ZCH(7)=HLCOMP_HLCOMP_HLCOMP_$$HLDATE^HLFNC($P($G(^SRF(CASE,31)),U,4))_HLCOMP_$$HLDATE^HLFNC($P($G(^(31)),U,5))_HLCOMP_HLCOMP_HLCOMP_HLCOMP_HLCOMP_$P($G(^SRF(CASE,0)),U,11)
|
---|
| 19 | I $G(SRSTATUS)'="(SCHEDULED)" S ZCH(7)=HLCOMP_HLCOMP_HLCOMP_$$HLDATE^HLFNC($P(^SRF(CASE,0),U,9))_HLCOMP_HLCOMP_HLCOMP_HLCOMP_HLCOMP_HLCOMP_$P($G(^SRF(CASE,0)),U,11)
|
---|
| 20 | I $D(^SRF(CASE,"1.0")) S ZCH(12)=$P($G(^("1.0")),U,10) I ZCH(12)'="" S ZCH(12)=$$HNAME^SRHLU($G(ZCH(12)))
|
---|
| 21 | I $D(^SRF(CASE,"CON")) S ZCH(17)=$P($G(^("CON")),U)
|
---|
| 22 | S ^TMP(SRENT,$J,SRI)="ZCH"_HL("FS") F XX=1:1:18 S ^TMP(SRENT,$J,SRI)=^TMP(SRENT,$J,SRI)_$G(ZCH(XX))_$S(XX=18:"",1:HL("FS"))
|
---|
| 23 | S SRI=SRI+1
|
---|
| 24 | Q
|
---|
| 25 | ZIG(SRI,SRENT) ;sets ^TMP(SRENT,$J global for sending ZIG Appointment Information - General Resource Segment(s)
|
---|
| 26 | Q:'$D(^SRF(CASE,27,0))
|
---|
| 27 | N MON,ZIG
|
---|
| 28 | S MON=0 F S MON=$O(^SRF(CASE,27,MON)) Q:'MON S ZIG=^SRF(CASE,27,MON,0) D
|
---|
| 29 | .S ZIG(1)=$P(ZIG,U)_HLCOMP_$P($G(^SRO(133.4,$P(ZIG,U),0)),U)_HLCOMP_"99VA133.4"
|
---|
| 30 | .S ZIG(2)=HLCOMP_"MONITOR"_HLCOMP
|
---|
| 31 | .S ^TMP(SRENT,$J,SRI)="ZIG"_HL("FS") F XX=1:1:4 S ^TMP(SRENT,$J,SRI)=^TMP(SRENT,$J,SRI)_$G(ZIG(XX))_$S(XX=4:"",1:HL("FS")),ZIG(XX)=""
|
---|
| 32 | .S SRI=SRI+1
|
---|
| 33 | Q
|
---|
| 34 | ZIL(SRI,SRENT) ;sets ^TMP(SRENT,$J global for sending ZIL Appointment Information - Location Resource Segment(s)
|
---|
| 35 | N FAC,LOC,SRC,X,ZIL
|
---|
| 36 | I '$P(^SRF(CASE,0),U,2),'$D(^SRF(CASE,"NON")) Q
|
---|
| 37 | I $P(^SRF(CASE,0),U,2) S LOC=$P($G(^SRS($P(^SRF(CASE,0),U,2),0)),U) I $G(LOC)'="" S LOC=$P(^SC(LOC,0),U),FAC=$P(^(0),U,4) I $G(FAC)="" S FAC=$P($G(^SRF(CASE,8)),U)
|
---|
| 38 | I $D(^SRF(CASE,"NON")),$P(^("NON"),U,2) S LOC=$P(^SRF(CASE,"NON"),U,2) I $G(LOC)'="" S LOC=$P(^SC(LOC,0),U),FAC=$P(^(0),U,4) I $G(FAC)="" S FAC=$P($G(^SRF(CASE,8)),U)
|
---|
| 39 | S ZIL(1)=$G(FAC)_HLCOMP_HLCOMP_HLCOMP_$G(LOC)
|
---|
| 40 | S ZIL(2)=HLCOMP_$S($P($G(^SRF(CASE,"NON")),U)="Y":"NON OR",1:"OPERATING ROOM")
|
---|
| 41 | S SRC=0 D S ZIL(6)=$S($G(SRC)=1:"PENDING",1:"CONFIRMED")
|
---|
| 42 | .I $D(^SRF(CASE,"REQ"))&($G(SRSTATUS)="(REQUESTED)") S:^SRF(CASE,"REQ")=1&($P($G(^SRF(CASE,.2)),U,2)="") SRC=1
|
---|
| 43 | .I SRSTATUS="(SCHEDULED)" D STAT
|
---|
| 44 | S ^TMP(SRENT,$J,SRI)="ZIL"_HL("FS") F X=1:1:6 S ^TMP(SRENT,$J,SRI)=^TMP(SRENT,$J,SRI)_$G(ZIL(X))_$S(X=6:"",1:HL("FS")),ZIL(X)=""
|
---|
| 45 | S SRI=SRI+1
|
---|
| 46 | Q
|
---|
| 47 | ZIP(SRI,SRENT) ;sets ^TMP(SRENT,$J,I) global for sending ZIP Appointment Information - Personnel Segment(s)
|
---|
| 48 | N SRC,X,XX,ZIP
|
---|
| 49 | I $D(^SRF(CASE,"NON")) D
|
---|
| 50 | .I $P(^SRF(CASE,"NON"),U,6)'="" S ZIP(1)=$$HNAME^SRHLU($P(^("NON"),U,6)),ZIP(2)=HLCOMP_"PROVIDER"_HLCOMP_"99VA200" D SZIP
|
---|
| 51 | .I $P(^SRF(CASE,"NON"),U,7)'="" S ZIP(1)=$$HNAME^SRHLU($P(^("NON"),U,7)),ZIP(2)=HLCOMP_"ATTEND PROVIDER"_HLCOMP_"99VA200" D SZIP
|
---|
| 52 | I $D(^SRF(CASE,.1)) F X=4,5,6,13 S ZIP(1)=$P($G(^SRF(CASE,.1)),U,X) I $G(ZIP(1))'="" D
|
---|
| 53 | .S ZIP(1)=$$HNAME^SRHLU(ZIP(1)),ZIP(2)=HLCOMP_$S(X=4:"SURGEON",X=5:"1ST ASST.",X=6:"2ND ASST.",X=13:"ATT. SURGEON",1:"")_HLCOMP_"99VA200"
|
---|
| 54 | .D SZIP
|
---|
| 55 | S X=0 F X=1,4 S ZIP(1)=$P($G(^SRF(CASE,.3)),U,X) I $G(ZIP(1))'="" D
|
---|
| 56 | .S ZIP(1)=$$HNAME^SRHLU(ZIP(1)),ZIP(2)=HLCOMP_$S(X=1:"PRIN. ANES.",X=4:"ANES. SUPER.",1:"")_HLCOMP_"99VA200"
|
---|
| 57 | .D SZIP
|
---|
| 58 | Q
|
---|
| 59 | SZIP ;set the ZIP segment
|
---|
| 60 | S SRC=0 D S ZIP(6)=$S($G(SRC)=1:"PENDING",1:"CONFIRMED")
|
---|
| 61 | .I $D(^SRF(CASE,"REQ"))&($G(SRSTATUS)="(REQUESTED)") S:^SRF(CASE,"REQ")=1&($P($G(^SRF(CASE,.2)),U,2)="") SRC=1
|
---|
| 62 | .I SRSTATUS="(SCHEDULED)" D STAT
|
---|
| 63 | S ^TMP(SRENT,$J,SRI)="ZIP"_HL("FS") F XX=1:1:6 S ^TMP(SRENT,$J,SRI)=^TMP(SRENT,$J,SRI)_$G(ZIP(XX))_$S(XX=6:"",1:HL("FS")),ZIP(XX)=""
|
---|
| 64 | S SRI=SRI+1
|
---|
| 65 | Q
|
---|
| 66 | STAT ;check scheduled cases to scheduled close time
|
---|
| 67 | N SRI,SRS,SRTIME,X1,X2
|
---|
| 68 | Q:'$D(^SRF(CASE,31))
|
---|
| 69 | S SRI=$P($G(^SRF(CASE,8)),U),SRS=$O(^SRO(133,"B",SRI,0)),SRTIME=$P(^SRO(133,SRS,0),U,12) S:SRTIME="" SRTIME=1500
|
---|
| 70 | S X1=$E($P(^SRF(CASE,0),U,9),1,7),X2=-1,SRYN="N" D C^%DTC D Q:X'=DT S SRTIME=X_"."_SRTIME D NOW^%DTC I %>SRTIME S SRC=0
|
---|
| 71 | .I X'<DT S SRC=1
|
---|
| 72 | .I X<DT S SRC=0
|
---|
| 73 | Q
|
---|