source: WorldVistAEHR/trunk/r/SURGERY-SR/SRHLVUO1.m@ 1769

Last change on this file since 1769 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.9 KB
RevLine 
[613]1SRHLVUO1 ;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.
5ZCH(SRI,SREVENT,SRSTATUS) ;sets ^TMP("HLS",$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))=HLQ
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^SRHLVU($G(ZCH(12)))
21 I $D(^SRF(CASE,"CON")) S ZCH(17)=$P($G(^("CON")),U)
22 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)
23 S SRI=SRI+1
24 Q
25ZIG(SRI) ;sets ^TMP("HLS",$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("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)=""
32 .S SRI=SRI+1
33 Q
34ZIL(SRI) ;sets ^TMP("HLS",$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,2):"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 $G(SRSTATUS)="(SCHEDULED)" D STAT
44 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)=""
45 S SRI=SRI+1
46 Q
47ZIP(SRI) ;sets ^TMP("HLS",$J,HLSDT,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^SRHLVU($P(^("NON"),U,6)),ZIP(2)=HLCOMP_"PROVIDER"_HLCOMP_"99VA200" D SZIP
51 .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
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^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"
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^SRHLVU(ZIP(1)),ZIP(2)=HLCOMP_$S(X=1:"PRIN. ANES.",X=4:"ANES. SUPER.",1:"")_HLCOMP_"99VA200"
57 .D SZIP
58 Q
59SZIP ;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 $G(SRSTATUS)="(SCHEDULED)" D STAT
63 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)=""
64 S SRI=SRI+1
65 Q
66STAT ;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
Note: See TracBrowser for help on using the repository browser.