SRHLUO3 ;BIR/DLR - Surgery Interface (Cont.) Utilities for building Outgoing HL7 Segments ; [ 05/20/99 7:14 AM ]
;;3.0;Surgery;**41,88,127,151,177**;24 Jun 93;Build 89
;
; Reference to ^PSS50 supported by DBIA #4533
; Reference to $$OBA^ICDEX supported by DBIA #5747
; Reference to $$CODEABA^ICDEX supported by DBIA #5747
; Reference to $$ICDDATA^ICDXCODE supported by DBIA #5699
; Reference to $$IMPDATE^LEXU supported by DBIA #5679
;
;
;INIT^HLTRANS MUST BE called before calling this routine.
;Mandatory variables
;I - IEN of the entry to be processed
;SRI - next available number in ^TMP(SRENT... global
MFE(SRI,REC,FILE,FIELD,SRENT) ;Master File Entry segment
N I,ID,SRCODE,SRORDER,SRX,SRY,X,SRRX,SRSYS
;event point processing
I $G(SRENT)'="" S I=$P(SRENT,U),ID=$P(SRENT,U,2) D SMFE
;set of codes
I $G(SRENT)="",$G(FIELD)'="" S Y="",C=$P(^DD(FILE,FIELD,0),U,2) D Y^DIQ F X=2:1:$L(C,";")-1 S I=X-1,ID=$P($P(C,";",X),":",2) D SMFE
;files
I $G(SRENT)="",$G(FIELD)="" D
.I FILE=50 S SDT=$$FMADD^XLFDT(DT,-366) F S SDT=$O(^SRF("AC",SDT)) Q:'SDT!(SDT>DT) S XIEN=0 F S XIEN=$O(^SRF("AC",SDT,XIEN)) Q:'XIEN D
..I $D(^SRF(XIEN,22,0)) S X2=0 F S X2=$O(^SRF(XIEN,22,X2)) Q:'X2 I $D(^(X2,0)) S I=$P(^(0),U) D DATA^PSS50(I,,,,,"SRRX") S ^TMP("SRHL",$J,"MED",I)=HLCOMP_$P($G(^TMP($J,"SRRX",I,.01)),"^")_HLCOMP
..K ^TMP($J,"SRRX",I)
..S X2=0 F S X2=$O(^TMP("SRHL",$J,"MED",X2)) Q:'X2 S ID=^(X2) D SMFE,ZRX
..K ^TMP("SRHL",$J,"MED")
.I FILE=44 S I=0 F S I=$O(^SC(I)) Q:'I S ID=$P(^(I,0),U)_HLCOMP_HLCOMP D SMFE
.I FILE=80 F SRSYS=1,30 S SRORDER="" F S SRORDER=$$OBA^ICDEX(80,SRORDER,+SRSYS) Q:'$L(SRORDER) D
..S SRCODE=$TR(SRORDER," ",""),I=$$CODEABA^ICDEX(SRCODE,FILE,SRSYS) S ID=SRCODE_HLCOMP_HLCOMP D SMFE,@$S(SRSYS=1:"ZI9",1:"ZI0")
.I FILE=81 S I=0 F S I=$O(^ICPT("B",I)) Q:I="" S ID=I_HLCOMP_HLCOMP D SMFE,ZC4
.I FILE=133.4 S I=0 F S I=$O(^SRO(133.4,I)) Q:'I S ID=HLCOMP_$P(^(I,0),U)_HLCOMP D SMFE,ZMN
.I FILE=133.7 S I=0 F S I=$O(^SRO(133.7,I)) Q:'I S ID=HLCOMP_$P(^(I,0),U)_HLCOMP D SMFE,ZRF
.I FILE=200 S SDT=$$FMADD^XLFDT(DT,-366) F S SDT=$O(^SRF("AC",SDT)) Q:'SDT!(SDT>DT) S XIEN=0 F S XIEN=$O(^SRF("AC",SDT,XIEN)) Q:'XIEN D
..;4-surgeon,5-first asst.,6-second asst.,13-attend surgeon
..I $D(^SRF(XIEN,.1)) F XF=4,5,6,13 S I=$P(^SRF(XIEN,.1),U,XF),ROLE=$S(XF=4:"SURGEON",XF=5:"1ST ASST.",XF=6:"2ND ASST.",XF=13:"ATT. SURGEON") D:I'="" XPER
..;1-prin. anes.,2-relief anes.,3-asst. anes.,4-anes. super.
..I $D(^SRF(XIEN,.3)) F XF=1,2,3,4 S I=$P(^SRF(XIEN,.3),U,XF),ROLE=$S(XF=1:"PRIN. ANES.",XF=2:"RELIEF ANESTHETIST",XF=3:"ASSISTANT ANESTHETIST",XF=4:"ANES. SUPER.") D:I'="" XPER
..;tourniquet applied by
..I $D(^SRF(XIEN,2,0)) S X2=0 F S X2=$O(^SRF(XIEN,2,X2)) Q:'X2 S I=$P(^(X2,0),U,3),ROLE="TOURNIQUET APPLIED BY" D:I'="" XPER
..;monitor applied by
..I $D(^SRF(XIEN,27,0)) S X2=0 F S X2=$O(^SRF(XIEN,27,X2)) Q:'X2 S I=$P(^(X2,0),U,4),ROLE="MONITOR APPLIED BY" D:I'="" XPER
..;extubated by
..I $D(^SRF(XIEN,6,0)) S X2=0 F S X2=$O(^SRF(XIEN,6,X2)) Q:'X2 I $D(^(X2,6)) S I=$P(^(6),U),ROLE="EXTUBATED BY" D:I'="" XPER
..;medications administered by, ordered by
..I $D(^SRF(XIEN,22,0)) S X2=0 F S X2=$O(^SRF(XIEN,22,X2)) Q:'X2 I $D(^(X2,0)) F XF=3,4 S I=$P(^(0),U,XF),ROLE=$S(XF=3:"MEDICATION ORDERED BY",XF=4:"MEDICATION ADM BY") D:I'="" XPER
.S I=0 F S I=$O(^TMP("SRHL",$J,"PER",I)) Q:'I S ID=^(I) D SMFE,STF
.K ^TMP("SRHL",$J,"PER")
Q
SMFE ;
S ^TMP("HLS",$J,SRI)="MFE"_HL("FS")_REC_HL("FS")_I_HL("FS")_$E(DT,1,8)_HL("FS")_ID,SRI=SRI+1
Q
MFI(SRI,ID,FEC,FILE,SRENT) ;Master File Identification segment
N SRY
I '$D(ID)!'$D(FEC) W !!,"Invalid Master File Identifier or Event Code.",!! Q
;S SRY=$$IMPDATE^SROICD("10D"),SRY=$S(DT'<IMPDATE:"10",1:"9")
S SRY=$$IMPDATE^SROICD("10D"),SRY=$S(DT'<SRY:"10",1:"9")
S ^TMP("HLS",$J,SRI)="MFI"_HL("FS")_HLCOMP_ID_HLCOMP_$S(FILE=80:$S(SRY=9:"I9",SRY=10:"I0",1:""),FILE=81:"C4",$E(FILE,1,3)'=130:"99VA"_FILE,1:"L")_HL("FS")_HL("FS")_FEC_HL("FS")_HL("FS")_HL("FS")_"AL",SRI=SRI+1
Q
STF ;staff master file
S ^TMP("HLS",$J,SRI)="STF"_HL("FS")_$P($G(^VA(200,I,1)),U,9)_HLCOMP_HLCOMP_HL("FS")_HL("FS")_$P($$HNAME^SRHLU(I),HLCOMP,2,3),SRI=SRI+1
Q
ZI9 ;master file update to ICD-9 (File #80)
S SRY=$$ICDDATA^ICDXCODE("DIAG",SRCODE,$$IMPDATE^LEXU("10D")-1),^TMP("HLS",$J,SRI)="ZI9"_HL("FS")_$P(SRY,U,2)_HLCOMP_$E($P(SRY,U,4),1,30)_HLCOMP_HL("FS")_$S($P(SRY,U,10)'="":$P(SRY,U,10),1:0),SRI=SRI+1
Q
ZI0 ;master file update to ICD-10 (File #80)
S SRY=$$ICDDATA^ICDXCODE("DIAG",SRCODE,$$IMPDATE^LEXU("10D")+1),^TMP("HLS",$J,SRI)="ZI0"_HL("FS")_$P(SRY,U,2)_HLCOMP_$E($P(SRY,U,4),1,30)_HLCOMP_HL("FS")_$S($P(SRY,U,10)'="":$P(SRY,U,10),1:0),SRI=SRI+1
Q
ZC4 ;master file update to CPT-4 (File #81)
S SRX=$$CPT^ICPTCOD(I),^TMP("HLS",$J,SRI)="ZC4"_HL("FS")_$P(SRX,U,2)_HLCOMP_$P(SRX,U,3)_HLCOMP_HL("FS")_$S($P(SRX,U,7)'="":$P(SRX,U,7),1:0),SRI=SRI+1
Q
ZRX ;master file update to MEDICATION (File #50)
D DATA^PSS50(I,,,,,"SRRX") S ^TMP("HLS",$J,SRI)="ZRX"_HL("FS")_HLCOMP_$P($G(^TMP($J,"SRRX",I,.01)),"^")_HLCOMP_HL("FS")_$P($G(^("I")),U)_HL("FS")_$S($P($G(^(2)),U,3)["S":1,1:0),SRI=SRI+1
K ^TMP($J,"SRRX",I)
Q
ZMN ;master file update to MONITOR (File #133.2)
S ^TMP("HLS",$J,SRI)="ZMN"_HL("FS")_HLCOMP_$P(^SRO(133.4,I,0),U)_HLCOMP_HL("FS")_$S($P(^(0),U,2)'="":$P(^(0),U,2),1:0),SRI=SRI+1
Q
ZRF ;master file update to REPLACEMENT FLUIDS (File #133.7)
S ^TMP("HLS",$J,SRI)="ZRF"_HL("FS")_HLCOMP_$P(^SRO(133.7,I,0),U)_HLCOMP_HL("FS")_$S($P(^(0),U,2)'="":$P(^(0),U,2),1:0),SRI=SRI+1
Q
;cpt4,icd9,medication,monitor,personnel,replacement fluid
I SRTYP'=3,(SRTYP'=5) D MSG^SRHLMFN(SRTBL,FEC,REC,SRENT)
Q
XPER ;personnel information extract (SSN) from file 200
S ^TMP("SRHL",$J,"PER",I)=$$HNAME^SRHLU(I)_"^"_ROLE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSRHLUO3 5823 printed Nov 22, 2024@17:49:26 Page 2
SRHLUO3 ;BIR/DLR - Surgery Interface (Cont.) Utilities for building Outgoing HL7 Segments ; [ 05/20/99 7:14 AM ]
+1 ;;3.0;Surgery;**41,88,127,151,177**;24 Jun 93;Build 89
+2 ;
+3 ; Reference to ^PSS50 supported by DBIA #4533
+4 ; Reference to $$OBA^ICDEX supported by DBIA #5747
+5 ; Reference to $$CODEABA^ICDEX supported by DBIA #5747
+6 ; Reference to $$ICDDATA^ICDXCODE supported by DBIA #5699
+7 ; Reference to $$IMPDATE^LEXU supported by DBIA #5679
+8 ;
+9 ;
+10 ;INIT^HLTRANS MUST BE called before calling this routine.
+11 ;Mandatory variables
+12 ;I - IEN of the entry to be processed
+13 ;SRI - next available number in ^TMP(SRENT... global
MFE(SRI,REC,FILE,FIELD,SRENT) ;Master File Entry segment
+1 NEW I,ID,SRCODE,SRORDER,SRX,SRY,X,SRRX,SRSYS
+2 ;event point processing
+3 IF $GET(SRENT)'=""
SET I=$PIECE(SRENT,U)
SET ID=$PIECE(SRENT,U,2)
DO SMFE
+4 ;set of codes
+5 IF $GET(SRENT)=""
IF $GET(FIELD)'=""
SET Y=""
SET C=$PIECE(^DD(FILE,FIELD,0),U,2)
DO Y^DIQ
FOR X=2:1:$LENGTH(C,";")-1
SET I=X-1
SET ID=$PIECE($PIECE(C,";",X),":",2)
DO SMFE
+6 ;files
+7 IF $GET(SRENT)=""
IF $GET(FIELD)=""
Begin DoDot:1
+8 IF FILE=50
SET SDT=$$FMADD^XLFDT(DT,-366)
FOR
SET SDT=$ORDER(^SRF("AC",SDT))
if 'SDT!(SDT>DT)
QUIT
SET XIEN=0
FOR
SET XIEN=$ORDER(^SRF("AC",SDT,XIEN))
if 'XIEN
QUIT
Begin DoDot:2
+9 IF $DATA(^SRF(XIEN,22,0))
SET X2=0
FOR
SET X2=$ORDER(^SRF(XIEN,22,X2))
if 'X2
QUIT
IF $DATA(^(X2,0))
SET I=$PIECE(^(0),U)
DO DATA^PSS50(I,,,,,"SRRX")
SET ^TMP("SRHL",$JOB,"MED",I)=HLCOMP_$PIECE($GET(^TMP($JOB,"SRRX",I,.01)),"^")_HLCOMP
+10 KILL ^TMP($JOB,"SRRX",I)
+11 SET X2=0
FOR
SET X2=$ORDER(^TMP("SRHL",$JOB,"MED",X2))
if 'X2
QUIT
SET ID=^(X2)
DO SMFE
DO ZRX
+12 KILL ^TMP("SRHL",$JOB,"MED")
End DoDot:2
+13 IF FILE=44
SET I=0
FOR
SET I=$ORDER(^SC(I))
if 'I
QUIT
SET ID=$PIECE(^(I,0),U)_HLCOMP_HLCOMP
DO SMFE
+14 IF FILE=80
FOR SRSYS=1,30
SET SRORDER=""
FOR
SET SRORDER=$$OBA^ICDEX(80,SRORDER,+SRSYS)
if '$LENGTH(SRORDER)
QUIT
Begin DoDot:2
+15 SET SRCODE=$TRANSLATE(SRORDER," ","")
SET I=$$CODEABA^ICDEX(SRCODE,FILE,SRSYS)
SET ID=SRCODE_HLCOMP_HLCOMP
DO SMFE
DO @$SELECT(SRSYS=1:"ZI9",1:"ZI0")
End DoDot:2
+16 IF FILE=81
SET I=0
FOR
SET I=$ORDER(^ICPT("B",I))
if I=""
QUIT
SET ID=I_HLCOMP_HLCOMP
DO SMFE
DO ZC4
+17 IF FILE=133.4
SET I=0
FOR
SET I=$ORDER(^SRO(133.4,I))
if 'I
QUIT
SET ID=HLCOMP_$PIECE(^(I,0),U)_HLCOMP
DO SMFE
DO ZMN
+18 IF FILE=133.7
SET I=0
FOR
SET I=$ORDER(^SRO(133.7,I))
if 'I
QUIT
SET ID=HLCOMP_$PIECE(^(I,0),U)_HLCOMP
DO SMFE
DO ZRF
+19 IF FILE=200
SET SDT=$$FMADD^XLFDT(DT,-366)
FOR
SET SDT=$ORDER(^SRF("AC",SDT))
if 'SDT!(SDT>DT)
QUIT
SET XIEN=0
FOR
SET XIEN=$ORDER(^SRF("AC",SDT,XIEN))
if 'XIEN
QUIT
Begin DoDot:2
+20 ;4-surgeon,5-first asst.,6-second asst.,13-attend surgeon
+21 IF $DATA(^SRF(XIEN,.1))
FOR XF=4,5,6,13
SET I=$PIECE(^SRF(XIEN,.1),U,XF)
SET ROLE=$SELECT(XF=4:"SURGEON",XF=5:"1ST ASST.",XF=6:"2ND ASST.",XF=13:"ATT. SURGEON")
if I'=""
DO XPER
+22 ;1-prin. anes.,2-relief anes.,3-asst. anes.,4-anes. super.
+23 IF $DATA(^SRF(XIEN,.3))
FOR XF=1,2,3,4
SET I=$PIECE(^SRF(XIEN,.3),U,XF)
SET ROLE=$SELECT(XF=1:"PRIN. ANES.",XF=2:"RELIEF ANESTHETIST",XF=3:"ASSISTANT ANESTHETIST",XF=4:"ANES. SUPER.")
if I'=""
DO XPER
+24 ;tourniquet applied by
+25 IF $DATA(^SRF(XIEN,2,0))
SET X2=0
FOR
SET X2=$ORDER(^SRF(XIEN,2,X2))
if 'X2
QUIT
SET I=$PIECE(^(X2,0),U,3)
SET ROLE="TOURNIQUET APPLIED BY"
if I'=""
DO XPER
+26 ;monitor applied by
+27 IF $DATA(^SRF(XIEN,27,0))
SET X2=0
FOR
SET X2=$ORDER(^SRF(XIEN,27,X2))
if 'X2
QUIT
SET I=$PIECE(^(X2,0),U,4)
SET ROLE="MONITOR APPLIED BY"
if I'=""
DO XPER
+28 ;extubated by
+29 IF $DATA(^SRF(XIEN,6,0))
SET X2=0
FOR
SET X2=$ORDER(^SRF(XIEN,6,X2))
if 'X2
QUIT
IF $DATA(^(X2,6))
SET I=$PIECE(^(6),U)
SET ROLE="EXTUBATED BY"
if I'=""
DO XPER
+30 ;medications administered by, ordered by
+31 IF $DATA(^SRF(XIEN,22,0))
SET X2=0
FOR
SET X2=$ORDER(^SRF(XIEN,22,X2))
if 'X2
QUIT
IF $DATA(^(X2,0))
FOR XF=3,4
SET I=$PIECE(^(0),U,XF)
SET ROLE=$SELECT(XF=3:"MEDICATION ORDERED BY",XF=4:"MEDICATION ADM BY")
if I'=""
DO XPER
End DoDot:2
+32 SET I=0
FOR
SET I=$ORDER(^TMP("SRHL",$JOB,"PER",I))
if 'I
QUIT
SET ID=^(I)
DO SMFE
DO STF
+33 KILL ^TMP("SRHL",$JOB,"PER")
End DoDot:1
+34 QUIT
SMFE ;
+1 SET ^TMP("HLS",$JOB,SRI)="MFE"_HL("FS")_REC_HL("FS")_I_HL("FS")_$EXTRACT(DT,1,8)_HL("FS")_ID
SET SRI=SRI+1
+2 QUIT
MFI(SRI,ID,FEC,FILE,SRENT) ;Master File Identification segment
+1 NEW SRY
+2 IF '$DATA(ID)!'$DATA(FEC)
WRITE !!,"Invalid Master File Identifier or Event Code.",!!
QUIT
+3 ;S SRY=$$IMPDATE^SROICD("10D"),SRY=$S(DT'<IMPDATE:"10",1:"9")
+4 SET SRY=$$IMPDATE^SROICD("10D")
SET SRY=$SELECT(DT'<SRY:"10",1:"9")
+5 SET ^TMP("HLS",$JOB,SRI)="MFI"_HL("FS")_HLCOMP_ID_HLCOMP_$SELECT(FILE=80:$SELECT(SRY=9:"I9",SRY=10:"I0",1:""),FILE=81:"C4",$EXTRACT(FILE,1,3)'=130:"99VA"_FILE,1:"L")_HL("FS")_HL("FS")_FEC_HL("FS")_HL("FS")_HL("FS")_"AL"
SET SRI=SRI+1
+6 QUIT
STF ;staff master file
+1 SET ^TMP("HLS",$JOB,SRI)="STF"_HL("FS")_$PIECE($GET(^VA(200,I,1)),U,9)_HLCOMP_HLCOMP_HL("FS")_HL("FS")_$PIECE($$HNAME^SRHLU(I),HLCOMP,2,3)
SET SRI=SRI+1
+2 QUIT
ZI9 ;master file update to ICD-9 (File #80)
+1 SET SRY=$$ICDDATA^ICDXCODE("DIAG",SRCODE,$$IMPDATE^LEXU("10D")-1)
SET ^TMP("HLS",$JOB,SRI)="ZI9"_HL("FS")_$PIECE(SRY,U,2)_HLCOMP_$EXTRACT($PIECE(SRY,U,4),1,30)_HLCOMP_HL("FS")_$SELECT($PIECE(SRY,U,10)'="":$PIECE(SRY,U,10),1:0)
SET SRI=SRI+1
+2 QUIT
ZI0 ;master file update to ICD-10 (File #80)
+1 SET SRY=$$ICDDATA^ICDXCODE("DIAG",SRCODE,$$IMPDATE^LEXU("10D")+1)
SET ^TMP("HLS",$JOB,SRI)="ZI0"_HL("FS")_$PIECE(SRY,U,2)_HLCOMP_$EXTRACT($PIECE(SRY,U,4),1,30)_HLCOMP_HL("FS")_$SELECT($PIECE(SRY,U,10)'="":$PIECE(SRY,U,10),1:0)
SET SRI=SRI+1
+2 QUIT
ZC4 ;master file update to CPT-4 (File #81)
+1 SET SRX=$$CPT^ICPTCOD(I)
SET ^TMP("HLS",$JOB,SRI)="ZC4"_HL("FS")_$PIECE(SRX,U,2)_HLCOMP_$PIECE(SRX,U,3)_HLCOMP_HL("FS")_$SELECT($PIECE(SRX,U,7)'="":$PIECE(SRX,U,7),1:0)
SET SRI=SRI+1
+2 QUIT
ZRX ;master file update to MEDICATION (File #50)
+1 DO DATA^PSS50(I,,,,,"SRRX")
SET ^TMP("HLS",$JOB,SRI)="ZRX"_HL("FS")_HLCOMP_$PIECE($GET(^TMP($JOB,"SRRX",I,.01)),"^")_HLCOMP_HL("FS")_$PIECE($GET(^("I")),U)_HL("FS")_$SELECT($PIECE($GET(^(2)),U,3)["S":1,1:0)
SET SRI=SRI+1
+2 KILL ^TMP($JOB,"SRRX",I)
+3 QUIT
ZMN ;master file update to MONITOR (File #133.2)
+1 SET ^TMP("HLS",$JOB,SRI)="ZMN"_HL("FS")_HLCOMP_$PIECE(^SRO(133.4,I,0),U)_HLCOMP_HL("FS")_$SELECT($PIECE(^(0),U,2)'="":$PIECE(^(0),U,2),1:0)
SET SRI=SRI+1
+2 QUIT
ZRF ;master file update to REPLACEMENT FLUIDS (File #133.7)
+1 SET ^TMP("HLS",$JOB,SRI)="ZRF"_HL("FS")_HLCOMP_$PIECE(^SRO(133.7,I,0),U)_HLCOMP_HL("FS")_$SELECT($PIECE(^(0),U,2)'="":$PIECE(^(0),U,2),1:0)
SET SRI=SRI+1
+2 QUIT
+3 ;cpt4,icd9,medication,monitor,personnel,replacement fluid
+4 IF SRTYP'=3
IF (SRTYP'=5)
DO MSG^SRHLMFN(SRTBL,FEC,REC,SRENT)
+5 QUIT
XPER ;personnel information extract (SSN) from file 200
+1 SET ^TMP("SRHL",$JOB,"PER",I)=$$HNAME^SRHLU(I)_"^"_ROLE
+2 QUIT
