[613] | 1 | TIUHL7U1 ; SLC/AJB - TIUHL7 Utilities; March 23, 2005
|
---|
| 2 | ;;1.0;TEXT INTEGRATION UTILITIES;**200,228**;Jun 20, 1997
|
---|
| 3 | Q
|
---|
| 4 | ACK(CODE,ERLOC,TIUDA) ;
|
---|
| 5 | N HLA,RESULT,TIUMID,TIUREC,TIUSND
|
---|
| 6 | S HLA("HLA",1)="MSA"_HL("FS")_CODE_HL("FS")_HL("MID")_HL("FS")_$G(HL("RAN"))_HL("FS")_$G(HL("SAN"))
|
---|
| 7 | S TIUMID=$G(HL("MID")),TIUREC=HL("RAN"),TIUSND=HL("SAN")
|
---|
| 8 | I CODE="AR" D
|
---|
| 9 | . N TIUCNT
|
---|
| 10 | . S TIUCNT=0 F S TIUCNT=$O(@ERLOC@("MSGERR",TIUCNT)) Q:'+TIUCNT S HLA("HLA",(TIUCNT+1))=@ERLOC@("MSGERR",TIUCNT)
|
---|
| 11 | . I +$E($G(TIU("SSN")),1,5) D SNDALRT("TIUHL7 rejected an incoming HL7 message from "_TIUSND_" (Msg ID "_TIUMID_".")
|
---|
| 12 | I CODE="AA" D
|
---|
| 13 | . S HLA("HLA",2)="ERR"_TIUFS_TIUFS_TIUFS_TIUFS_+$G(TIUDA)_TIUCS_"Document creation successful."
|
---|
| 14 | I HL("SAN")="HTAPPL" D M @TIU("XTMP")@("MSGRESULT")=HLA("HLS") Q
|
---|
| 15 | . N HL,HLL,HLP,TIUDNS,TIUEVT,TIUFAC,TIULLNK,TIUSUB
|
---|
| 16 | . M HLA("HLS")=HLA("HLA") K HLA("HLA")
|
---|
| 17 | . S TIUEVT="TIUHL7 HTAPPL ACK EVT",TIUSUB="TIUHL7 HTAPPL ACK SUB"
|
---|
| 18 | . I '+$$LU^TIUHL7U1(101,TIUEVT) D SNDALRT("Unable to resolve Event Protocol for ACK to "_TIUSND_".")
|
---|
| 19 | . I '+$$LU^TIUHL7U1(101,TIUSUB) D SNDALRT("Unable to resolve Subscriber Protocol for ACK to "_TIUSND_".")
|
---|
| 20 | . S TIUFAC=$P(TIUMSG(1),TIUFS,4),TIUDNS=$P(TIUFAC,TIUCS,2) ; set facility & DNS address
|
---|
| 21 | . S TIULLNK(1)=$$LU^TIUHL7U1(870,$$UP^XLFSTR(TIUDNS),,,"DNS"),TIULLNK(2)=$$LU^TIUHL7U1(870,$$LOW^XLFSTR(TIUDNS),,,"DNS")
|
---|
| 22 | . S TIULLNK=$S(+TIULLNK(1):TIULLNK(1),+TIULLNK(2):TIULLNK(2),1:0) I '+TIULLNK D SNDALRT("Unable to resolve DNS for ACK to "_TIUSND_".")
|
---|
| 23 | . S TIULLNK=$$GET1^DIQ(870,TIULLNK,.01) ; get logical link associated with DNS
|
---|
| 24 | . D INIT^HLFNC2(TIUEVT,.HL) I +$G(HL) Q
|
---|
| 25 | . S HLP("SUBSCRIBER")="^^^^"_TIUFAC
|
---|
| 26 | . S HLL("LINKS",1)=TIUSUB_U_TIULLNK
|
---|
| 27 | . D GENERATE^HLMA(TIUEVT,"LM",1,.TIURSLT,"",.HLP)
|
---|
| 28 | D GENACK^HLMA1(HL("EID"),HLMTIENS,HL("EIDS"),"LM",1,.TIURSLT)
|
---|
| 29 | M @TIU("XTMP")@("MSGRESULT")=HLA("HLA")
|
---|
| 30 | Q
|
---|
| 31 | SNDALRT(MSG) ;
|
---|
| 32 | N XQA,XQAMSG
|
---|
| 33 | S MSG("RECEIVER")=$P($$GETAPP^HLCS2(TIUREC),U),MSG("SENDER")=$P($$GETAPP^HLCS2(TIUSND),U)
|
---|
| 34 | I '+$L(MSG("RECEIVER")),'+$L(MSG("SENDER")) Q
|
---|
| 35 | I +$L(MSG("RECEIVER")) S XQA("G."_MSG("RECEIVER"))=""
|
---|
| 36 | I +$L(MSG("SENDER")) S XQA("G."_MSG("SENDER"))=""
|
---|
| 37 | S XQAMSG=MSG
|
---|
| 38 | I $$SETUP1^XQALERT
|
---|
| 39 | Q
|
---|
| 40 | AUDIT(TIUDA,TIUCKSM0,TIUCKSM1) ; Update audit trail
|
---|
| 41 | N DA,DIC,DIE,DLAYGO,DR,X,Y
|
---|
| 42 | S X=""""_"`"_TIUDA_"""",(DIC,DLAYGO)=8925.5,DIC(0)="FLX" D ^DIC Q:+Y'>0
|
---|
| 43 | S DIE=DIC,DR=".02////"_$$NOW^TIULC_";.03////"_TIU("EBDA")_";.04////"_TIUCKSM0_";.05////"_TIUCKSM1
|
---|
| 44 | S DA=+Y D ^DIE
|
---|
| 45 | Q
|
---|
| 46 | CANEDIT(DA) ; check whether or not document is released
|
---|
| 47 | Q $S(+$P($G(^TIU(8925,+DA,0)),U,5)<4:1,1:0)
|
---|
| 48 | CLASS(CLNAME) ;
|
---|
| 49 | N TIUY S TIUY=+$O(^TIU(8925.1,"B",CLNAME,0))
|
---|
| 50 | I +TIUY>0,$S($P($G(^TIU(8925.1,+TIUY,0)),U,4)="CL":0,$P($G(^(0)),U,4)="DC":0,1:1) S TIUY=0
|
---|
| 51 | Q TIUY
|
---|
| 52 | CLEAN ; removes messages older than 7 days
|
---|
| 53 | N TIUDT
|
---|
| 54 | S TIUDT=0
|
---|
| 55 | F S TIUDT=$O(^XTMP("TIUHL7",TIUDT)) Q:'+TIUDT D
|
---|
| 56 | . I $$FMDIFF^XLFDT($$NOW^XLFDT,TIUDT)'<7 K ^XTMP("TIUHL7",TIUDT)
|
---|
| 57 | Q
|
---|
| 58 | COMPARE(NAME1,NAME2) ; compare first and last names only
|
---|
| 59 | N NAME,TIUX,TIUY
|
---|
| 60 | S TIUY=0
|
---|
| 61 | I $L(NAME1,",")=1,$L(NAME2,",")=1 S:NAME1=NAME2 TIUY=1 Q TIUY
|
---|
| 62 | S NAME("L1")=$P(NAME1,","),NAME("F1")=$P(NAME1,",",2),NAME("F1")=$P(NAME("F1")," ")
|
---|
| 63 | S NAME("L2")=$P(NAME2,","),NAME("F2")=$P(NAME2,",",2),NAME("F2")=$P(NAME("F2")," ")
|
---|
| 64 | I NAME("L1")=NAME("L2"),NAME("F1")=NAME("F2") S TIUY=1
|
---|
| 65 | Q TIUY
|
---|
| 66 | DELDOC(TIUDA) ;
|
---|
| 67 | N ERR
|
---|
| 68 | D DELETE^TIUSRVP(.ERR,TIUDA,"",1)
|
---|
| 69 | Q
|
---|
| 70 | ERR(TIUSEG,TIUP,TIUNUM,TIUTXT) ;
|
---|
| 71 | S TIU("EC")=TIU("EC")+1
|
---|
| 72 | S @TIUNAME@("MSGERR",TIU("EC"))="ERR"_TIUFS_TIUSEG_TIUFS_TIUP_TIUFS_TIUFS_TIUNUM_TIUCS_TIUTXT
|
---|
| 73 | Q
|
---|
| 74 | GETADMIT(DFN,TIUDT) ;
|
---|
| 75 | N TIUCNT,TIULIST,TIUY S (TIUCNT,TIUY)=0
|
---|
| 76 | I '+$G(TIUDT) Q TIUY
|
---|
| 77 | D:+$G(DFN) ADMITLST^ORWPT(.TIULIST,DFN)
|
---|
| 78 | I $D(TIULIST) D
|
---|
| 79 | . S TIULIST="" F S TIULIST=$O(TIULIST(TIULIST)) Q:'+TIULIST I $P($P(TIULIST(TIULIST),U),".")=$P(TIUDT,".") S TIUCNT=TIUCNT+1,TIUCNT(TIULIST)=TIULIST(TIULIST)
|
---|
| 80 | . I TIUCNT=0 D ERR("ERR","44","0000.00","ADMISSION not found for "_$$FMTE^XLFDT(TIUDT)_".") Q
|
---|
| 81 | . I TIUCNT=1 S TIULIST="",TIULIST=$O(TIUCNT(TIULIST)),TIU("VSTR")=$P(TIULIST(TIULIST),U,2)_";"_$P(TIULIST(TIULIST),U)_";H",TIUY=1 Q
|
---|
| 82 | . I +TIU("HLOC") D
|
---|
| 83 | . . S TIULIST="" F S TIULIST=$O(TIUCNT(TIULIST)) Q:'+TIULIST!(+TIUY) I $P(TIUCNT(TIULIST),U,2)=TIU("HLOC") S TIU("VSTR")=TIU("HLOC")_";"_$P(TIUCNT(TIULIST),U)_";H",TIUY=1
|
---|
| 84 | Q TIUY
|
---|
| 85 | GETDIV(USER) ;
|
---|
| 86 | N TIUY
|
---|
| 87 | D DIV4^XUSER(.TIUY,USER) I +$D(TIUY) S TIUY="",TIUY=$O(TIUY(TIUY))
|
---|
| 88 | I +$G(TIUY)'>0 S TIUY=$$GET1^DIQ(8989.3,1,217,"I")
|
---|
| 89 | Q TIUY
|
---|
| 90 | GETVISIT(DFN,TIUDT) ;
|
---|
| 91 | N TIUCNT,TIULIST,TIUY
|
---|
| 92 | S (TIUCNT,TIUY)=0
|
---|
| 93 | I '+$G(TIUDT) Q TIUY
|
---|
| 94 | D:+$G(DFN) VST1^ORWCV(.TIULIST,DFN,$P(TIUDT,"."),$$FMADD^XLFDT(TIUDT,1),1)
|
---|
| 95 | I $D(TIULIST) D
|
---|
| 96 | . S TIULIST="" F S TIULIST=$O(TIULIST(TIULIST)) Q:'+TIULIST I $P($P(TIULIST(TIULIST),U,2),".")=$P(TIUDT,".") S TIUCNT=TIUCNT+1,TIUCNT(TIULIST)=TIULIST(TIULIST)
|
---|
| 97 | . I TIUCNT=1 S TIULIST="",TIULIST=$O(TIUCNT(TIULIST)),TIU("VSTR")=$P($P(TIULIST(TIULIST),U),";",3)_";"_$P(TIULIST(TIULIST),U,2)_";"_$S(TIU("AVAIL")="AV":"E",1:"A"),TIUY=1 Q
|
---|
| 98 | . I +TIU("HLOC") D
|
---|
| 99 | . . S TIULIST="" F S TIULIST=$O(TIUCNT(TIULIST)) Q:'+TIULIST!(+TIUY) I $P($P(TIULIST(TIULIST),U),";",3)=TIU("HLOC") S TIU("VSTR")=TIU("HLOC")_";"_$P(TIULIST(TIULIST),U,2)_";"_$S(TIU("AVAIL")="AV":"E",1:"A"),TIUY=1
|
---|
| 100 | Q TIUY
|
---|
| 101 | LU(FILE,NAME,FLAGS,SCREEN,INDEXES) ;
|
---|
| 102 | Q $$FIND1^DIC(FILE,"",$G(FLAGS),NAME,$G(INDEXES),$G(SCREEN),"TIUERR")
|
---|
| 103 | MEMBEROF(TITLE,CLASS) ;
|
---|
| 104 | N TIUY S TIUY=0
|
---|
| 105 | S CLASS=+$$CLASS(CLASS) Q:+CLASS'>0 TIUY
|
---|
| 106 | S TITLE=$$LU(8925.1,TITLE,"X","I $P(^(0),U,4)=""DOC""") Q:+TITLE'>0 TIUY
|
---|
| 107 | S TIUY=+$$ISA^TIULX(TITLE,CLASS)
|
---|
| 108 | Q TIUY
|
---|
| 109 | PNAME(NAME) ;
|
---|
| 110 | N LAST,FIRST
|
---|
| 111 | S LAST=$P(NAME,","),FIRST=$E($P(NAME,",",2),1)
|
---|
| 112 | Q LAST_","_FIRST
|
---|
| 113 | REMESC(TIUSTR) ;
|
---|
| 114 | ; Remove Escape Characters from HL7 Message Text
|
---|
| 115 | ; Escape Sequence codes:
|
---|
| 116 | ; F = field separator (TIUFS)
|
---|
| 117 | ; S = component separator (TIUCS)
|
---|
| 118 | ; R = repitition separator (TIURS)
|
---|
| 119 | ; E = escape character (TIUES)
|
---|
| 120 | ; T = subcomponent separator (TIUSS)
|
---|
| 121 | N I1,I2,J1,J2,K,TIUCHR,TIUREP,VALUE
|
---|
| 122 | F TIUCHR="F","S","R","E","T" S TIUREP(TIUES_TIUCHR_TIUES)=$S(TIUCHR="F":TIUFS,TIUCHR="S":TIUCS,TIUCHR="R":TIURS,TIUCHR="E":TIUES,TIUCHR="T":TIUSS)
|
---|
| 123 | S TIUSTR=$$REPLACE^XLFSTR(TIUSTR,.TIUREP)
|
---|
| 124 | F S I1=$P(TIUSTR,TIUES_"X") Q:$L(I1)=$L(TIUSTR) D
|
---|
| 125 | .S I2=$P(TIUSTR,TIUES_"X",2,99)
|
---|
| 126 | .S J1=$P(I2,TIUES) Q:'$L(J1)
|
---|
| 127 | .S J2=$P(I2,TIUES,2,99)
|
---|
| 128 | .S VALUE=$$BASE^XLFUTL($$UP^XLFSTR(J1),16,10)
|
---|
| 129 | .S K=$S(VALUE>255:"?",VALUE<32!(VALUE>127&(VALUE<160)):"",1:$C(VALUE))
|
---|
| 130 | .S TIUSTR=I1_K_J2
|
---|
| 131 | Q TIUSTR
|
---|
| 132 | SIGNDOC(TIUDA) ;
|
---|
| 133 | N TIUDEL
|
---|
| 134 | I $G(TIU("COMP"))="LA",'+TIU("EC") D
|
---|
| 135 | . I '+$G(TIU("SIGNED")),'+$G(TIU("CSIGNED")) D Q
|
---|
| 136 | . . I TIU("AVAIL")'="AV" D DELDOC(TIUDA),ERR("TIU","","2100.040","SIGNATURE DATE[TIME] missing from HL7 message & availability not 'AV'; document has been deleted.")
|
---|
| 137 | . I +TIU("SIGNED") D
|
---|
| 138 | . . N TIUACT,TIUAUTH,TIUES,TIUSTAT S TIUACT="SIGNATURE",TIUAUTH=$$CANDO^TIULP(TIUDA,TIUACT,TIU("AUDA")) I '+TIUAUTH D
|
---|
| 139 | . . . D ERR("TIU","15","0000.000",$P(TIUAUTH,U,2)) I TIU("AVAIL")="AV" Q
|
---|
| 140 | . . . S TIUDEL=1 D ERR("TIU","","0000.000","Legal authentication failed & availability not 'AV'; document has been deleted.")
|
---|
| 141 | . . I '+$G(TIUDEL) S TIUES=1_U_$$GET1^DIQ(200,TIU("AUDA"),20.2)_U_$$GET1^DIQ(200,TIU("AUDA"),20.3)
|
---|
| 142 | . . I '+$G(TIUDEL) D ES^TIUHL7U2(TIUDA,TIUES,"",TIU("AUDA"))
|
---|
| 143 | . . I '+$G(TIUDEL) S TIUSTAT=$P($G(^TIU(8925,TIUDA,0)),U,5) I TIUSTAT<6,TIU("AVAIL")'="AV" D
|
---|
| 144 | . . . S TIUDEL=1 D ERR("TIU","","0000.000","Legal authentication failed & availability not 'AV'; document has been deleted.")
|
---|
| 145 | . I +TIU("CSIGNED") D
|
---|
| 146 | . . N TIUACT,TIUAUTH,TIUES,TIUSTAT S TIUACT="COSIGNATURE",TIUAUTH=$$CANDO^TIULP(TIUDA,TIUACT,TIU("CSDA")) I '+TIUAUTH D
|
---|
| 147 | . . . D ERR("TIU","29","0000.000",$P(TIUAUTH,U,2)) I TIU("AVAIL")="AV" Q
|
---|
| 148 | . . . S TIUDEL=1 D ERR("TIU","29","0000.000","Legal authentication failed & availability not 'AV'; document has been deleted.")
|
---|
| 149 | . . I '+$G(TIUDEL) S TIUES=1_U_$$GET1^DIQ(200,TIU("CSDA"),20.2)_U_$$GET1^DIQ(200,TIU("CSDA"),20.3)
|
---|
| 150 | . . I '+$G(TIUDEL) D ES^TIURS(TIUDA,TIUES,"",TIU("CSDA"))
|
---|
| 151 | . . I '+$G(TIUDEL) S TIUSTAT=$P($G(^TIU(8925,TIUDA,0)),U,5) I TIUSTAT'=7,TIU("AVAIL")'="AV" D
|
---|
| 152 | . . . S TIUDEL=1 D ERR("TIU","29","0000.000","Legal authentication failed & availability not 'AV'; document has been deleted.")
|
---|
| 153 | I +$G(TIUDEL) D DELDOC(TIUDA)
|
---|
| 154 | Q
|
---|