- SRHLVUO ;B'HAM ISC/DLR - Surgery Interface Utilities for building Outgoing HL7 Segment ; [ 05/06/98 7:14 AM ]
- ;;3.0;Surgery;**41,127,177**;24 Jun 93;Build 89
- ;
- ; ** ASSUMMED variable list
- ; all - INIT^HLTRANS
- ; DFN - IEN file #2
- ; SRI - incremental variable ^TMP("HLS",$J,HLSDT,SRI)
- ; - returns the next #
- ; CASE- IEN (file 130) case number must be set before the call
- ;
- AL1(SRI) ;AL1 segment(s) builder returns allergy information from the generic call to (GMRADPT)
- Q:'$D(DFN)
- S X="GMRADPT" X ^%ZOSF("TEST") Q:'$T
- N TYPE,X,AL1,CNT
- ;Allergy package valid entry point returns GMRAL(x)
- D ^GMRADPT
- S CNT=1
- F X=0:0 S X=$O(GMRAL(X)) Q:X'>0 D
- .S TYPE=$P(GMRAL(X),"^",3),AL1(X)="AL1"_HLFS_$E("0000",$L(CNT)+1,4)_CNT_HLFS_$S(TYPE="D":"DA",TYPE="F":"FA",TYPE="O":"MA",1:"")_HLFS_HLCOMP_$P(GMRAL(X),"^",2)
- .S ^TMP("HLS",$J,HLSDT,SRI)=AL1(X),SRI=SRI+1,CNT=CNT+1
- K GMRAL
- Q
- DG1(SRI) ;DG1 segment(s) builder returns surgery diagnosis information
- Q:'$D(CASE)
- N DG1,I9,X,X1,SRSYS
- I $D(^SRF(CASE,34)),$P(^SRF(CASE,34),U,2) D
- .S SRSYS=$$ICDSYS^SROICD($P(^SRF(CASE,0),"^",9)),I9=$$ICD^SROICD(CASE,$P(^SRF(CASE,34),U,2))
- .S DG1="DG1"_HLFS_"0001"_HLFS_$S(SRSYS["9":"I9",1:"I0")_HLFS_$P(I9,U,2)_HLFS_$E($P(I9,U,4),1,40)_HLFS_HLFS_"P" D
- ..S ^TMP("HLS",$J,HLSDT,SRI)=DG1,SRI=SRI+1,DG1=""
- ..I $D(^SRF(CASE,14,0)) S X1=2 F X=0:0 S X=$O(^SRF(CASE,14,X)) Q:X'>0 D
- ...I $P(^(0),U,3) S I9=$$ICD^SROICD(CASE,$P(^SRF(CASE,14,0),U,3)) D
- ....S ^TMP("HLS",$J,HLSDT,SRI)="DG1"_HLFS_$E("0000",$L(X1)+1,4)_X1_HLFS_$S(SRSYS["9":"I9",1:"I0")_HLFS_$P(I9,U,2)_HLFS_$E($P(I9,U,4),1,40)_HLFS_HLFS_"PR",X1=X1+1,SRI=SRI+1
- Q
- ERR(SRI,SRERR) ;ERR segment builder
- ; SRERR = error code and location (segment^sequence #^field^error)
- ; (ONLY AE Application Errors')
- ;
- S ^TMP("HLS",$J,HLSDT,SRI)="ERR"_HLFS_$G(SRERR(1))_HLCOMP_$G(SRERR(2))_HLCOMP_$G(HLERR),SRI=SRI+1
- Q
- MSA(SRI,SRAC) ;MSA segment builder
- ; SRAC = Acknowledgement code (ID)
- ; AA = Application Accepted (responsed with information)
- ; AE = Application Error (bad data send error response)
- ; AR = Application Reject
- ;
- N MSA
- S MSA(1)=$G(SRAC),MSA(2)=$G(HLMID),MSA(3)=$G(SRERR)
- S ^TMP("HLS",$J,HLSDT,SRI)="MSA"_HLFS F XX=1:1:3 S ^TMP("HLS",$J,HLSDT,SRI)=$G(^TMP("HLS",$J,HLSDT,SRI))_$G(MSA(XX))_$S(XX=3:"",1:HLFS)
- S SRI=SRI+1
- Q
- OBX(SRI) ;OBX segment(s) builder
- ; This segment builds OBX segments for the following Preoperative data
- ; - vitals\measurements ^GMRVUTL routine:
- ; height, weight, blood pressure, pulse rate, and temperature
- ; - IN\OUT-PATIENT STATUS field in File #130
- ; - CANCEL DATE and CANCEL REASON for cancelled and aborted cases
- ; - SURGICAL SPECIALTY (OR) or MEDICAL SPECIALTY (NON OR)
- ; - SURGEON PGY and ANES SUPERVISE CODE
- Q:'$D(CASE)
- N OBX,CNT,TYPE,X,Y
- S CNT=1
- I $D(^SRF(CASE,"NON")) S OBX(2)="CE",OBX(3)=HLCOMP_"MEDICAL SPECIALTY"_HLCOMP,OBX(5)=$P(^("NON"),U,8) I OBX(5)'="" S OBX(5)=HLCOMP_$P(^ECC(723,OBX(5),0),U)_HLCOMP_"99VA723" D SOBX
- I $P(^SRF(CASE,0),U,4)'="" S OBX(2)="CE",OBX(3)=HLCOMP_"SURGICAL SPECIALTY"_HLCOMP,OBX(5)=$P(^(0),U,4) I OBX(5)'="" S OBX(5)=HLCOMP_$P(^SRO(137.45,OBX(5),0),U)_HLCOMP_"99VA137.45" D SOBX
- I $D(^SRF(CASE,200)) I $P(^SRF(CASE,200),U,52)'="" S OBX(2)="NM",OBX(3)=HLCOMP_"SURGEON PGY"_HLCOMP_"L",OBX(5)=$P(^(200),U,52) D SOBX
- I $D(^SRF(CASE,.3)) I $P(^SRF(CASE,.3),U,6)'="" S OBX(2)="CE",OBX(3)=HLCOMP_"ANES SUPERVISE CODE"_HLCOMP_"L",OBX(5)=$P(^(.3),U,6) D SOBX
- I $P(^SRF(CASE,0),U,12)'="" S OBX(2)="CE",OBX(3)=HLCOMP_"PATIENT CLASS"_HLCOMP,OBX(5)=$P(^(0),U,12) S C=$P(^DD(130,.011,0),U,2),Y=OBX(5) D Y^DIQ S OBX(5)=HLCOMP_Y_HLCOMP_"L" D SOBX
- S X="GMRVUTL" X ^%ZOSF("TEST") I $T F TYPE="BP","HT","WT","T","P" S GMRVSTR=TYPE D EN6^GMRVUTL I $G(X)'="" S X1=$P(X,"^"),X2=60,SRX=X D C^%DTC I X'<DT D
- .S OBX(2)="CE",OBX(5)=$P(SRX,"^",8),OBX(11)="S",OBX(14)=$$HLDATE^HLFNC($P(SRX,"^")),OBX(16)=$$HNAME^SRHLVU($P(SRX,U,6))
- .I TYPE="BP" S OBX(3)="1002"_HLCOMP_"BP",OBX(5)=$P(SRX,"^",8) D SOBX
- .I TYPE="HT" S OBX(3)="1010.3"_HLCOMP_"Height",OBX(5)=$J(2.54*OBX(5),0,2),OBX(6)="cm" D SOBX
- .I TYPE="WT" S OBX(3)="1010.1"_HLCOMP_"Body Weight",OBX(5)=$J(OBX(5)/2.2,0,2),OBX(6)="kg" D SOBX
- .I TYPE="T" S OBX(3)="1000"_HLCOMP_"Temperature" S OBX(5)=$J(OBX(5)-32*5/9,0,2),OBX(6)="cel" D SOBX
- .I TYPE="P" S OBX(3)="1006.2"_HLCOMP_"HR",OBX(6)="min" D SOBX
- I $D(^SRF(CASE,30)),$P($G(^SRF(CASE,31)),U,8)'="" D
- .S OBX(2)="CE",OBX(3)=HLCOMP_"CANCEL REASON"_HLCOMP_"L",OBX(5)=HLCOMP_$P(^SRO(135,$P(^SRF(CASE,31),U,8),0),U)_HLCOMP_"L",OBX(14)=$$HLDATE^HLFNC($P(^SRF(CASE,30),U)),OBX(16)=$$HNAME^SRHLVU($P(^SRF(CASE,30),U,3)) D SOBX
- Q
- SOBX ;sets the OBX segment
- S OBX(11)="S"
- S OBX(1)=CNT
- S ^TMP("HLS",$J,HLSDT,SRI)="OBX"_HLFS F XX=1:1:16 S ^TMP("HLS",$J,HLSDT,SRI)=$G(^TMP("HLS",$J,HLSDT,SRI))_$G(OBX(XX))_$S(XX=16:"",1:HLFS),OBX(XX)=""
- S SRI=SRI+1,CNT=$G(CNT)+1
- Q
- PID(SRI) ;PID segment builder returns patient information
- Q:'$D(DFN)
- S ^TMP("HLS",$J,HLSDT,SRI)=$$EN^VAFHLPID(DFN,"1,3,4,5,6,7,8,11,13,16,19",1),SRI=SRI+1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRHLVUO 5064 printed Jan 18, 2025@03:40:46 Page 2
- SRHLVUO ;B'HAM ISC/DLR - Surgery Interface Utilities for building Outgoing HL7 Segment ; [ 05/06/98 7:14 AM ]
- +1 ;;3.0;Surgery;**41,127,177**;24 Jun 93;Build 89
- +2 ;
- +3 ; ** ASSUMMED variable list
- +4 ; all - INIT^HLTRANS
- +5 ; DFN - IEN file #2
- +6 ; SRI - incremental variable ^TMP("HLS",$J,HLSDT,SRI)
- +7 ; - returns the next #
- +8 ; CASE- IEN (file 130) case number must be set before the call
- +9 ;
- AL1(SRI) ;AL1 segment(s) builder returns allergy information from the generic call to (GMRADPT)
- +1 if '$DATA(DFN)
- QUIT
- +2 SET X="GMRADPT"
- XECUTE ^%ZOSF("TEST")
- if '$TEST
- QUIT
- +3 NEW TYPE,X,AL1,CNT
- +4 ;Allergy package valid entry point returns GMRAL(x)
- +5 DO ^GMRADPT
- +6 SET CNT=1
- +7 FOR X=0:0
- SET X=$ORDER(GMRAL(X))
- if X'>0
- QUIT
- Begin DoDot:1
- +8 SET TYPE=$PIECE(GMRAL(X),"^",3)
- SET AL1(X)="AL1"_HLFS_$EXTRACT("0000",$LENGTH(CNT)+1,4)_CNT_HLFS_$SELECT(TYPE="D":"DA",TYPE="F":"FA",TYPE="O":"MA",1:"")_HLFS_HLCOMP_$PIECE(GMRAL(X),"^",2)
- +9 SET ^TMP("HLS",$JOB,HLSDT,SRI)=AL1(X)
- SET SRI=SRI+1
- SET CNT=CNT+1
- End DoDot:1
- +10 KILL GMRAL
- +11 QUIT
- DG1(SRI) ;DG1 segment(s) builder returns surgery diagnosis information
- +1 if '$DATA(CASE)
- QUIT
- +2 NEW DG1,I9,X,X1,SRSYS
- +3 IF $DATA(^SRF(CASE,34))
- IF $PIECE(^SRF(CASE,34),U,2)
- Begin DoDot:1
- +4 SET SRSYS=$$ICDSYS^SROICD($PIECE(^SRF(CASE,0),"^",9))
- SET I9=$$ICD^SROICD(CASE,$PIECE(^SRF(CASE,34),U,2))
- +5 SET DG1="DG1"_HLFS_"0001"_HLFS_$SELECT(SRSYS["9":"I9",1:"I0")_HLFS_$PIECE(I9,U,2)_HLFS_$EXTRACT($PIECE(I9,U,4),1,40)_HLFS_HLFS_"P"
- Begin DoDot:2
- +6 SET ^TMP("HLS",$JOB,HLSDT,SRI)=DG1
- SET SRI=SRI+1
- SET DG1=""
- +7 IF $DATA(^SRF(CASE,14,0))
- SET X1=2
- FOR X=0:0
- SET X=$ORDER(^SRF(CASE,14,X))
- if X'>0
- QUIT
- Begin DoDot:3
- +8 IF $PIECE(^(0),U,3)
- SET I9=$$ICD^SROICD(CASE,$PIECE(^SRF(CASE,14,0),U,3))
- Begin DoDot:4
- +9 SET ^TMP("HLS",$JOB,HLSDT,SRI)="DG1"_HLFS_$EXTRACT("0000",$LENGTH(X1)+1,4)_X1_HLFS_$SELECT(SRSYS["9":"I9",1:"I0")_HLFS_$PIECE(I9,U,2)_HLFS_$EXTRACT($PIECE(I9,U,4),1,40)_HLFS_HLFS_"PR"
- SET X1=X1+1
- SET SRI=SRI+1
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +10 QUIT
- ERR(SRI,SRERR) ;ERR segment builder
- +1 ; SRERR = error code and location (segment^sequence #^field^error)
- +2 ; (ONLY AE Application Errors')
- +3 ;
- +4 SET ^TMP("HLS",$JOB,HLSDT,SRI)="ERR"_HLFS_$GET(SRERR(1))_HLCOMP_$GET(SRERR(2))_HLCOMP_$GET(HLERR)
- SET SRI=SRI+1
- +5 QUIT
- MSA(SRI,SRAC) ;MSA segment builder
- +1 ; SRAC = Acknowledgement code (ID)
- +2 ; AA = Application Accepted (responsed with information)
- +3 ; AE = Application Error (bad data send error response)
- +4 ; AR = Application Reject
- +5 ;
- +6 NEW MSA
- +7 SET MSA(1)=$GET(SRAC)
- SET MSA(2)=$GET(HLMID)
- SET MSA(3)=$GET(SRERR)
- +8 SET ^TMP("HLS",$JOB,HLSDT,SRI)="MSA"_HLFS
- FOR XX=1:1:3
- SET ^TMP("HLS",$JOB,HLSDT,SRI)=$GET(^TMP("HLS",$JOB,HLSDT,SRI))_$GET(MSA(XX))_$SELECT(XX=3:"",1:HLFS)
- +9 SET SRI=SRI+1
- +10 QUIT
- OBX(SRI) ;OBX segment(s) builder
- +1 ; This segment builds OBX segments for the following Preoperative data
- +2 ; - vitals\measurements ^GMRVUTL routine:
- +3 ; height, weight, blood pressure, pulse rate, and temperature
- +4 ; - IN\OUT-PATIENT STATUS field in File #130
- +5 ; - CANCEL DATE and CANCEL REASON for cancelled and aborted cases
- +6 ; - SURGICAL SPECIALTY (OR) or MEDICAL SPECIALTY (NON OR)
- +7 ; - SURGEON PGY and ANES SUPERVISE CODE
- +8 if '$DATA(CASE)
- QUIT
- +9 NEW OBX,CNT,TYPE,X,Y
- +10 SET CNT=1
- +11 IF $DATA(^SRF(CASE,"NON"))
- SET OBX(2)="CE"
- SET OBX(3)=HLCOMP_"MEDICAL SPECIALTY"_HLCOMP
- SET OBX(5)=$PIECE(^("NON"),U,8)
- IF OBX(5)'=""
- SET OBX(5)=HLCOMP_$PIECE(^ECC(723,OBX(5),0),U)_HLCOMP_"99VA723"
- DO SOBX
- +12 IF $PIECE(^SRF(CASE,0),U,4)'=""
- SET OBX(2)="CE"
- SET OBX(3)=HLCOMP_"SURGICAL SPECIALTY"_HLCOMP
- SET OBX(5)=$PIECE(^(0),U,4)
- IF OBX(5)'=""
- SET OBX(5)=HLCOMP_$PIECE(^SRO(137.45,OBX(5),0),U)_HLCOMP_"99VA137.45"
- DO SOBX
- +13 IF $DATA(^SRF(CASE,200))
- IF $PIECE(^SRF(CASE,200),U,52)'=""
- SET OBX(2)="NM"
- SET OBX(3)=HLCOMP_"SURGEON PGY"_HLCOMP_"L"
- SET OBX(5)=$PIECE(^(200),U,52)
- DO SOBX
- +14 IF $DATA(^SRF(CASE,.3))
- IF $PIECE(^SRF(CASE,.3),U,6)'=""
- SET OBX(2)="CE"
- SET OBX(3)=HLCOMP_"ANES SUPERVISE CODE"_HLCOMP_"L"
- SET OBX(5)=$PIECE(^(.3),U,6)
- DO SOBX
- +15 IF $PIECE(^SRF(CASE,0),U,12)'=""
- SET OBX(2)="CE"
- SET OBX(3)=HLCOMP_"PATIENT CLASS"_HLCOMP
- SET OBX(5)=$PIECE(^(0),U,12)
- SET C=$PIECE(^DD(130,.011,0),U,2)
- SET Y=OBX(5)
- DO Y^DIQ
- SET OBX(5)=HLCOMP_Y_HLCOMP_"L"
- DO SOBX
- +16 SET X="GMRVUTL"
- XECUTE ^%ZOSF("TEST")
- IF $TEST
- FOR TYPE="BP","HT","WT","T","P"
- SET GMRVSTR=TYPE
- DO EN6^GMRVUTL
- IF $GET(X)'=""
- SET X1=$PIECE(X,"^")
- SET X2=60
- SET SRX=X
- DO C^%DTC
- IF X'<DT
- Begin DoDot:1
- +17 SET OBX(2)="CE"
- SET OBX(5)=$PIECE(SRX,"^",8)
- SET OBX(11)="S"
- SET OBX(14)=$$HLDATE^HLFNC($PIECE(SRX,"^"))
- SET OBX(16)=$$HNAME^SRHLVU($PIECE(SRX,U,6))
- +18 IF TYPE="BP"
- SET OBX(3)="1002"_HLCOMP_"BP"
- SET OBX(5)=$PIECE(SRX,"^",8)
- DO SOBX
- +19 IF TYPE="HT"
- SET OBX(3)="1010.3"_HLCOMP_"Height"
- SET OBX(5)=$JUSTIFY(2.54*OBX(5),0,2)
- SET OBX(6)="cm"
- DO SOBX
- +20 IF TYPE="WT"
- SET OBX(3)="1010.1"_HLCOMP_"Body Weight"
- SET OBX(5)=$JUSTIFY(OBX(5)/2.2,0,2)
- SET OBX(6)="kg"
- DO SOBX
- +21 IF TYPE="T"
- SET OBX(3)="1000"_HLCOMP_"Temperature"
- SET OBX(5)=$JUSTIFY(OBX(5)-32*5/9,0,2)
- SET OBX(6)="cel"
- DO SOBX
- +22 IF TYPE="P"
- SET OBX(3)="1006.2"_HLCOMP_"HR"
- SET OBX(6)="min"
- DO SOBX
- End DoDot:1
- +23 IF $DATA(^SRF(CASE,30))
- IF $PIECE($GET(^SRF(CASE,31)),U,8)'=""
- Begin DoDot:1
- +24 SET OBX(2)="CE"
- SET OBX(3)=HLCOMP_"CANCEL REASON"_HLCOMP_"L"
- SET OBX(5)=HLCOMP_$PIECE(^SRO(135,$PIECE(^SRF(CASE,31),U,8),0),U)_HLCOMP_"L"
- SET OBX(14)=$$HLDATE^HLFNC($PIECE(^SRF(CASE,30),U))
- SET OBX(16)=$$HNAME^SRHLVU($PIECE(^SRF(CASE,30),U,3))
- DO SOBX
- End DoDot:1
- +25 QUIT
- SOBX ;sets the OBX segment
- +1 SET OBX(11)="S"
- +2 SET OBX(1)=CNT
- +3 SET ^TMP("HLS",$JOB,HLSDT,SRI)="OBX"_HLFS
- FOR XX=1:1:16
- SET ^TMP("HLS",$JOB,HLSDT,SRI)=$GET(^TMP("HLS",$JOB,HLSDT,SRI))_$GET(OBX(XX))_$SELECT(XX=16:"",1:HLFS)
- SET OBX(XX)=""
- +4 SET SRI=SRI+1
- SET CNT=$GET(CNT)+1
- +5 QUIT
- PID(SRI) ;PID segment builder returns patient information
- +1 if '$DATA(DFN)
- QUIT
- +2 SET ^TMP("HLS",$JOB,HLSDT,SRI)=$$EN^VAFHLPID(DFN,"1,3,4,5,6,7,8,11,13,16,19",1)
- SET SRI=SRI+1
- +3 QUIT