- SRHLVUO1 ;BIR/DLR - Surgery Interface (Cont.) Utilities for building Outgoing HL7 Segments ; [ 05/20/99 7:14 AM ]
- ;;3.0; Surgery ;**41,88,127**;24 Jun 93
- ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
- ;INIT^HLTRANS MUST BE called before calling this routine.
- ZCH(SRI,SREVENT,SRSTATUS) ;sets ^TMP("HLS",$J global for sending ZCH Scheduling Appointment Information segment(s)
- N ADD,ADD1,ADDR,PHONE,SRJ,SRM,SRP,SRREP,SRX,XX,ZCH,SROERR
- S (ZCH(1),ZCH(3))=HLQ
- S ZCH(2)=CASE
- ;eventid^text(STATUS)^coding scheme^...
- S ZCH(4)=$G(SREVENT)_HLCOMP_$G(SRSTATUS)_HLCOMP_"L"
- I $D(^SRF(CASE,"OP")) S ZCH(5)=$P($G(^("OP")),U,2) I ZCH(5)'="" D
- .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"
- .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
- ..S ZCH(18)=$G(ZCH(18))_$S(SRREP:HLREP,1:"")_$P(SRM,U,2)_HLCOMP_$P(SRM,U,3)_HLCOMP,SRREP=1
- I $G(ZCH(5))="" S ZCH(5)=HLCOMP_$P($G(^SRF(CASE,"OP")),U)
- 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"
- I $G(SRSTATUS)="(SCHEDULED)" D
- .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)
- 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)
- I $D(^SRF(CASE,"1.0")) S ZCH(12)=$P($G(^("1.0")),U,10) I ZCH(12)'="" S ZCH(12)=$$HNAME^SRHLVU($G(ZCH(12)))
- I $D(^SRF(CASE,"CON")) S ZCH(17)=$P($G(^("CON")),U)
- S ^TMP("HLS",$J,HLSDT,SRI)="ZCH"_HLFS F XX=1:1:18 S ^TMP("HLS",$J,HLSDT,SRI)=^TMP("HLS",$J,HLSDT,SRI)_$G(ZCH(XX))_$S(XX=18:"",1:HLFS)
- S SRI=SRI+1
- Q
- ZIG(SRI) ;sets ^TMP("HLS",$J global for sending ZIG Appointment Information - General Resource Segment(s)
- Q:'$D(^SRF(CASE,27,0))
- N MON,ZIG
- S MON=0 F S MON=$O(^SRF(CASE,27,MON)) Q:'MON S ZIG=^SRF(CASE,27,MON,0) D
- .S ZIG(1)=$P(ZIG,U)_HLCOMP_$P($G(^SRO(133.4,$P(ZIG,U),0)),U)_HLCOMP_"99VA133.4"
- .S ZIG(2)=HLCOMP_"MONITOR"_HLCOMP
- .S ^TMP("HLS",$J,HLSDT,SRI)="ZIG"_HLFS F XX=1:1:4 S ^TMP("HLS",$J,HLSDT,SRI)=^TMP("HLS",$J,HLSDT,SRI)_$G(ZIG(XX))_$S(XX=4:"",1:HLFS),ZIG(XX)=""
- .S SRI=SRI+1
- Q
- ZIL(SRI) ;sets ^TMP("HLS",$J global for sending ZIL Appointment Information - Location Resource Segment(s)
- N FAC,LOC,SRC,X,ZIL
- I '$P(^SRF(CASE,0),U,2),'$D(^SRF(CASE,"NON")) Q
- 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)
- 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)
- S ZIL(1)=$G(FAC)_HLCOMP_HLCOMP_HLCOMP_$G(LOC)
- S ZIL(2)=HLCOMP_$S($P($G(^SRF(CASE,"NON")),U,2):"NON OR",1:"OPERATING ROOM")
- S SRC=0 D S ZIL(6)=$S($G(SRC)=1:"PENDING",1:"CONFIRMED")
- .I $D(^SRF(CASE,"REQ"))&($G(SRSTATUS)="(REQUESTED)") S:^SRF(CASE,"REQ")=1&($P($G(^SRF(CASE,.2)),U,2)="") SRC=1
- .I $G(SRSTATUS)="(SCHEDULED)" D STAT
- S ^TMP("HLS",$J,HLSDT,SRI)="ZIL"_HLFS F X=1:1:6 S ^TMP("HLS",$J,HLSDT,SRI)=^TMP("HLS",$J,HLSDT,SRI)_$G(ZIL(X))_$S(X=6:"",1:HLFS),ZIL(X)=""
- S SRI=SRI+1
- Q
- ZIP(SRI) ;sets ^TMP("HLS",$J,HLSDT,I) global for sending ZIP Appointment Information - Personnel Segment(s)
- N SRC,X,XX,ZIP
- I $D(^SRF(CASE,"NON")) D
- .I $P(^SRF(CASE,"NON"),U,6)'="" S ZIP(1)=$$HNAME^SRHLVU($P(^("NON"),U,6)),ZIP(2)=HLCOMP_"PROVIDER"_HLCOMP_"99VA200" D SZIP
- .I $P(^SRF(CASE,"NON"),U,7)'="" S ZIP(1)=$$HNAME^SRHLVU($P(^("NON"),U,7)),ZIP(2)=HLCOMP_"ATTEND PROVIDER"_HLCOMP_"99VA200" D SZIP
- 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
- .S ZIP(1)=$$HNAME^SRHLVU(ZIP(1)),ZIP(2)=HLCOMP_$S(X=4:"SURGEON",X=5:"1ST ASST.",X=6:"2ND ASST.",X=13:"ATT. SURGEON",1:"")_HLCOMP_"99VA200"
- .D SZIP
- S X=0 F X=1,4 S ZIP(1)=$P($G(^SRF(CASE,.3)),U,X) I $G(ZIP(1))'="" D
- .S ZIP(1)=$$HNAME^SRHLVU(ZIP(1)),ZIP(2)=HLCOMP_$S(X=1:"PRIN. ANES.",X=4:"ANES. SUPER.",1:"")_HLCOMP_"99VA200"
- .D SZIP
- Q
- SZIP ;set the ZIP segment
- S SRC=0 D S ZIP(6)=$S($G(SRC)=1:"PENDING",1:"CONFIRMED")
- .I $D(^SRF(CASE,"REQ"))&($G(SRSTATUS)="(REQUESTED)") S:^SRF(CASE,"REQ")=1&($P($G(^SRF(CASE,.2)),U,2)="") SRC=1
- .I $G(SRSTATUS)="(SCHEDULED)" D STAT
- S ^TMP("HLS",$J,HLSDT,SRI)="ZIP"_HLFS F XX=1:1:6 S ^TMP("HLS",$J,HLSDT,SRI)=^TMP("HLS",$J,HLSDT,SRI)_$G(ZIP(XX))_$S(XX=6:"",1:HLFS),ZIP(XX)=""
- S SRI=SRI+1
- Q
- STAT ;check scheduled cases to scheduled close time
- N SRI,SRS,SRTIME,X1,X2
- Q:'$D(^SRF(CASE,31))
- 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
- 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
- .I X'<DT S SRC=1
- .I X<DT S SRC=0
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRHLVUO1 5051 printed Jan 18, 2025@03:40:47 Page 2
- SRHLVUO1 ;BIR/DLR - Surgery Interface (Cont.) Utilities for building Outgoing HL7 Segments ; [ 05/20/99 7:14 AM ]
- +1 ;;3.0; Surgery ;**41,88,127**;24 Jun 93
- +2 ; Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
- +3 ;INIT^HLTRANS MUST BE called before calling this routine.
- ZCH(SRI,SREVENT,SRSTATUS) ;sets ^TMP("HLS",$J global for sending ZCH Scheduling Appointment Information segment(s)
- +1 NEW ADD,ADD1,ADDR,PHONE,SRJ,SRM,SRP,SRREP,SRX,XX,ZCH,SROERR
- +2 SET (ZCH(1),ZCH(3))=HLQ
- +3 SET ZCH(2)=CASE
- +4 ;eventid^text(STATUS)^coding scheme^...
- +5 SET ZCH(4)=$GET(SREVENT)_HLCOMP_$GET(SRSTATUS)_HLCOMP_"L"
- +6 IF $DATA(^SRF(CASE,"OP"))
- SET ZCH(5)=$PIECE($GET(^("OP")),U,2)
- IF ZCH(5)'=""
- Begin DoDot:1
- +7 SET SRX=$$CPT^ICPTCOD(ZCH(5),$PIECE($GET(^SRF(CASE,0)),"^",9))
- SET ZCH(5)=$PIECE(SRX,U,2)_HLCOMP_$PIECE(SRX,U,3)_HLCOMP_"C4"
- +8 SET (SRJ,SRREP)=0
- FOR
- SET SRJ=$ORDER(^SRF(CASE,"OPMOD",SRJ))
- if 'SRJ
- QUIT
- SET SRP=$PIECE(^SRF(CASE,"OPMOD",SRJ,0),U)
- SET SRM=$$MOD^ICPTMOD(SRP,"I",$PIECE($GET(^SRF(CASE,0)),U,9))
- Begin DoDot:2
- +9 SET ZCH(18)=$GET(ZCH(18))_$SELECT(SRREP:HLREP,1:"")_$PIECE(SRM,U,2)_HLCOMP_$PIECE(SRM,U,3)_HLCOMP
- SET SRREP=1
- End DoDot:2
- End DoDot:1
- +10 IF $GET(ZCH(5))=""
- SET ZCH(5)=HLCOMP_$PIECE($GET(^SRF(CASE,"OP")),U)
- +11 IF $DATA(^SRF(CASE,".4"))
- SET ZCH(6)=$PIECE($GET(^(.4)),U)
- IF ZCH(6)'=""
- SET ZCH(6)=($PIECE(ZCH(6),":")*60)+($PIECE($GET(ZCH(6)),":",2))_HLCOMP_"min"
- +12 IF $GET(SRSTATUS)="(SCHEDULED)"
- Begin DoDot:1
- +13 SET ZCH(7)=HLCOMP_HLCOMP_HLCOMP_$$HLDATE^HLFNC($PIECE($GET(^SRF(CASE,31)),U,4))_HLCOMP_$$HLDATE^HLFNC($PIECE($GET(^(31)),U,5))_HLCOMP_HLCOMP_HLCOMP_HLCOMP_HLCOMP_$PIECE($GET(^SRF(CASE,0)),U,11)
- End DoDot:1
- +14 IF $GET(SRSTATUS)'="(SCHEDULED)"
- SET ZCH(7)=HLCOMP_HLCOMP_HLCOMP_$$HLDATE^HLFNC($PIECE(^SRF(CASE,0),U,9))_HLCOMP_HLCOMP_HLCOMP_HLCOMP_HLCOMP_HLCOMP_$PIECE($GET(^SRF(CASE,0)),U,11)
- +15 IF $DATA(^SRF(CASE,"1.0"))
- SET ZCH(12)=$PIECE($GET(^("1.0")),U,10)
- IF ZCH(12)'=""
- SET ZCH(12)=$$HNAME^SRHLVU($GET(ZCH(12)))
- +16 IF $DATA(^SRF(CASE,"CON"))
- SET ZCH(17)=$PIECE($GET(^("CON")),U)
- +17 SET ^TMP("HLS",$JOB,HLSDT,SRI)="ZCH"_HLFS
- FOR XX=1:1:18
- SET ^TMP("HLS",$JOB,HLSDT,SRI)=^TMP("HLS",$JOB,HLSDT,SRI)_$GET(ZCH(XX))_$SELECT(XX=18:"",1:HLFS)
- +18 SET SRI=SRI+1
- +19 QUIT
- ZIG(SRI) ;sets ^TMP("HLS",$J global for sending ZIG Appointment Information - General Resource Segment(s)
- +1 if '$DATA(^SRF(CASE,27,0))
- QUIT
- +2 NEW MON,ZIG
- +3 SET MON=0
- FOR
- SET MON=$ORDER(^SRF(CASE,27,MON))
- if 'MON
- QUIT
- SET ZIG=^SRF(CASE,27,MON,0)
- Begin DoDot:1
- +4 SET ZIG(1)=$PIECE(ZIG,U)_HLCOMP_$PIECE($GET(^SRO(133.4,$PIECE(ZIG,U),0)),U)_HLCOMP_"99VA133.4"
- +5 SET ZIG(2)=HLCOMP_"MONITOR"_HLCOMP
- +6 SET ^TMP("HLS",$JOB,HLSDT,SRI)="ZIG"_HLFS
- FOR XX=1:1:4
- SET ^TMP("HLS",$JOB,HLSDT,SRI)=^TMP("HLS",$JOB,HLSDT,SRI)_$GET(ZIG(XX))_$SELECT(XX=4:"",1:HLFS)
- SET ZIG(XX)=""
- +7 SET SRI=SRI+1
- End DoDot:1
- +8 QUIT
- ZIL(SRI) ;sets ^TMP("HLS",$J global for sending ZIL Appointment Information - Location Resource Segment(s)
- +1 NEW FAC,LOC,SRC,X,ZIL
- +2 IF '$PIECE(^SRF(CASE,0),U,2)
- IF '$DATA(^SRF(CASE,"NON"))
- QUIT
- +3 IF $PIECE(^SRF(CASE,0),U,2)
- SET LOC=$PIECE($GET(^SRS($PIECE(^SRF(CASE,0),U,2),0)),U)
- IF $GET(LOC)'=""
- SET LOC=$PIECE(^SC(LOC,0),U)
- SET FAC=$PIECE(^(0),U,4)
- IF $GET(FAC)=""
- SET FAC=$PIECE($GET(^SRF(CASE,8)),U)
- +4 IF $DATA(^SRF(CASE,"NON"))
- IF $PIECE(^("NON"),U,2)
- SET LOC=$PIECE(^SRF(CASE,"NON"),U,2)
- IF $GET(LOC)'=""
- SET LOC=$PIECE(^SC(LOC,0),U)
- SET FAC=$PIECE(^(0),U,4)
- IF $GET(FAC)=""
- SET FAC=$PIECE($GET(^SRF(CASE,8)),U)
- +5 SET ZIL(1)=$GET(FAC)_HLCOMP_HLCOMP_HLCOMP_$GET(LOC)
- +6 SET ZIL(2)=HLCOMP_$SELECT($PIECE($GET(^SRF(CASE,"NON")),U,2):"NON OR",1:"OPERATING ROOM")
- +7 SET SRC=0
- Begin DoDot:1
- +8 IF $DATA(^SRF(CASE,"REQ"))&($GET(SRSTATUS)="(REQUESTED)")
- if ^SRF(CASE,"REQ")=1&($PIECE($GET(^SRF(CASE,.2)),U,2)="")
- SET SRC=1
- +9 IF $GET(SRSTATUS)="(SCHEDULED)"
- DO STAT
- End DoDot:1
- SET ZIL(6)=$SELECT($GET(SRC)=1:"PENDING",1:"CONFIRMED")
- +10 SET ^TMP("HLS",$JOB,HLSDT,SRI)="ZIL"_HLFS
- FOR X=1:1:6
- SET ^TMP("HLS",$JOB,HLSDT,SRI)=^TMP("HLS",$JOB,HLSDT,SRI)_$GET(ZIL(X))_$SELECT(X=6:"",1:HLFS)
- SET ZIL(X)=""
- +11 SET SRI=SRI+1
- +12 QUIT
- ZIP(SRI) ;sets ^TMP("HLS",$J,HLSDT,I) global for sending ZIP Appointment Information - Personnel Segment(s)
- +1 NEW SRC,X,XX,ZIP
- +2 IF $DATA(^SRF(CASE,"NON"))
- Begin DoDot:1
- +3 IF $PIECE(^SRF(CASE,"NON"),U,6)'=""
- SET ZIP(1)=$$HNAME^SRHLVU($PIECE(^("NON"),U,6))
- SET ZIP(2)=HLCOMP_"PROVIDER"_HLCOMP_"99VA200"
- DO SZIP
- +4 IF $PIECE(^SRF(CASE,"NON"),U,7)'=""
- SET ZIP(1)=$$HNAME^SRHLVU($PIECE(^("NON"),U,7))
- SET ZIP(2)=HLCOMP_"ATTEND PROVIDER"_HLCOMP_"99VA200"
- DO SZIP
- End DoDot:1
- +5 IF $DATA(^SRF(CASE,.1))
- FOR X=4,5,6,13
- SET ZIP(1)=$PIECE($GET(^SRF(CASE,.1)),U,X)
- IF $GET(ZIP(1))'=""
- Begin DoDot:1
- +6 SET ZIP(1)=$$HNAME^SRHLVU(ZIP(1))
- SET ZIP(2)=HLCOMP_$SELECT(X=4:"SURGEON",X=5:"1ST ASST.",X=6:"2ND ASST.",X=13:"ATT. SURGEON",1:"")_HLCOMP_"99VA200"
- +7 DO SZIP
- End DoDot:1
- +8 SET X=0
- FOR X=1,4
- SET ZIP(1)=$PIECE($GET(^SRF(CASE,.3)),U,X)
- IF $GET(ZIP(1))'=""
- Begin DoDot:1
- +9 SET ZIP(1)=$$HNAME^SRHLVU(ZIP(1))
- SET ZIP(2)=HLCOMP_$SELECT(X=1:"PRIN. ANES.",X=4:"ANES. SUPER.",1:"")_HLCOMP_"99VA200"
- +10 DO SZIP
- End DoDot:1
- +11 QUIT
- SZIP ;set the ZIP segment
- +1 SET SRC=0
- Begin DoDot:1
- +2 IF $DATA(^SRF(CASE,"REQ"))&($GET(SRSTATUS)="(REQUESTED)")
- if ^SRF(CASE,"REQ")=1&($PIECE($GET(^SRF(CASE,.2)),U,2)="")
- SET SRC=1
- +3 IF $GET(SRSTATUS)="(SCHEDULED)"
- DO STAT
- End DoDot:1
- SET ZIP(6)=$SELECT($GET(SRC)=1:"PENDING",1:"CONFIRMED")
- +4 SET ^TMP("HLS",$JOB,HLSDT,SRI)="ZIP"_HLFS
- FOR XX=1:1:6
- SET ^TMP("HLS",$JOB,HLSDT,SRI)=^TMP("HLS",$JOB,HLSDT,SRI)_$GET(ZIP(XX))_$SELECT(XX=6:"",1:HLFS)
- SET ZIP(XX)=""
- +5 SET SRI=SRI+1
- +6 QUIT
- STAT ;check scheduled cases to scheduled close time
- +1 NEW SRI,SRS,SRTIME,X1,X2
- +2 if '$DATA(^SRF(CASE,31))
- QUIT
- +3 SET SRI=$PIECE($GET(^SRF(CASE,8)),U)
- SET SRS=$ORDER(^SRO(133,"B",SRI,0))
- SET SRTIME=$PIECE(^SRO(133,SRS,0),U,12)
- if SRTIME=""
- SET SRTIME=1500
- +4 SET X1=$EXTRACT($PIECE(^SRF(CASE,0),U,9),1,7)
- SET X2=-1
- SET SRYN="N"
- DO C^%DTC
- Begin DoDot:1
- +5 IF X'<DT
- SET SRC=1
- +6 IF X<DT
- SET SRC=0
- End DoDot:1
- if X'=DT
- QUIT
- SET SRTIME=X_"."_SRTIME
- DO NOW^%DTC
- IF %>SRTIME
- SET SRC=0
- +7 QUIT