[613] | 1 | DGHTHL7 ;ALB/JAM - Home Telehealth Patient Sign-up HL7;10 January 2005 ; 9/25/07 10:18am
|
---|
| 2 | ;;5.3;Registration;**644**;Aug 13, 1993;Build 11
|
---|
| 3 | ;
|
---|
| 4 | BLDHL7(DGHTH,MSG) ;Build HL7 Registration message for Home Telehealth
|
---|
| 5 | ;Input : DGHTH - Arry with Home Telehealth transaction data
|
---|
| 6 | ; MSG - Array to put message into (full global ref)
|
---|
| 7 | ;Output: N - Last line number used, or
|
---|
| 8 | ; 0 - no message built, or
|
---|
| 9 | ; -1^ErrorText on error
|
---|
| 10 | ; MSG will contain HL7 message
|
---|
| 11 | ;Note : Insertion into MSG begins at next available line number
|
---|
| 12 | ;
|
---|
| 13 | N DFN,VENDOR,CONSULT,COORD,EVENTDT,VALCHK,DGX,ERR,PROTNAME,VAFPID
|
---|
| 14 | N HLFS,HLECH,HLQ,HL,EVN,PID,PD1,PV1,LINE,X,Y
|
---|
| 15 | S ERR=0,X="" F S X=$O(DGHTH(X)) Q:X="" D I ERR Q
|
---|
| 16 | .I DGHTH(X)="" S VALCHK="-1^Bad Input ("_X_")",ERR=1 Q
|
---|
| 17 | .S @X=DGHTH(X)
|
---|
| 18 | I ERR Q $G(VALCHK)
|
---|
| 19 | I $G(MSG)="" Q "-1^Bad input variable (MSG)"
|
---|
| 20 | S PROTNAME="DG HOME TELEHEALTH ADT-A04 SERVER"
|
---|
| 21 | D INIT^HLFNC2(PROTNAME,.HL)
|
---|
| 22 | I ($O(HL(""))="") Q "-1^Unable to initialize HL7 variables"
|
---|
| 23 | S LINE=+$O(@MSG@(""),-1)
|
---|
| 24 | ;
|
---|
| 25 | ;EVN segment
|
---|
| 26 | S EVN=$$EVN("A04","A04",EVENTDT)
|
---|
| 27 | I $P(EVN,U)=-1 K @MSG Q EVN
|
---|
| 28 | S LINE=LINE+1 S @MSG@(LINE)=EVN
|
---|
| 29 | ;
|
---|
| 30 | ;PID segment
|
---|
| 31 | S PID=$$PID(DFN,.HL,.VAFPID)
|
---|
| 32 | I $P(PID,U)=-1 Q PID
|
---|
| 33 | D PIDVAL I ERR Q ERR
|
---|
| 34 | S DGX=$O(VAFPID(0)),LINE=LINE+1 S @MSG@(LINE)=VAFPID(DGX)
|
---|
| 35 | F S DGX=$O(VAFPID(DGX)) Q:'DGX D
|
---|
| 36 | .S @MSG@(LINE,DGX-1)=VAFPID(DGX)
|
---|
| 37 | ;
|
---|
| 38 | ;PD1 segment
|
---|
| 39 | S PD1=$$PD1(DFN,COORD)
|
---|
| 40 | I $P(PD1,U)=-1 Q PD1
|
---|
| 41 | S LINE=LINE+1 S @MSG@(LINE)=PD1
|
---|
| 42 | ;
|
---|
| 43 | ;PV1 segment
|
---|
| 44 | S $P(PV1,HLFS,1)=1,$P(PV1,HLFS,5)=CONSULT
|
---|
| 45 | S $P(PV1,HLFS,39)=$$STA^XUAF4(DUZ(2))
|
---|
| 46 | S PV1="PV1"_HLFS_PV1
|
---|
| 47 | S LINE=LINE+1 S @MSG@(LINE)=PV1
|
---|
| 48 | ;
|
---|
| 49 | Q LINE
|
---|
| 50 | ;
|
---|
| 51 | EVN(TYPE,FLAG,DGEVDT) ;Build EVN segment
|
---|
| 52 | ;Input: TYPE - HL7 event type
|
---|
| 53 | ; FLAG - HL7 Event Reason Code
|
---|
| 54 | ; DGEVDT - Event Date/Time [Optional]
|
---|
| 55 | ;Output: value - EVN segment
|
---|
| 56 | ; -1^ErrorText on error
|
---|
| 57 | ;
|
---|
| 58 | N USRNAM,USERID,COMP,SUBCOMP,EVN
|
---|
| 59 | I $G(TYPE)=""!($G(FLAG)="") Q "-1^Value missing to build message (EVN segment)"
|
---|
| 60 | S EVN=$$EVN^VAFHLEVN(TYPE,FLAG,DGEVDT)
|
---|
| 61 | I ($E(EVN,1,3)'="EVN") Q "-1^Error build message (EVN segment)"
|
---|
| 62 | ;Add user and user's facility to EVN segment
|
---|
| 63 | S COMP=$E(HL("ECH"),1),SUBCOMP=$E(HL("ECH"),4)
|
---|
| 64 | S USRNAM=$$HLNAME^HLFNC($$GET1^DIQ(200,DUZ_",",.01),HL("ECH"))
|
---|
| 65 | S USERID=DUZ_COMP_$P(USRNAM,COMP)_COMP_$P(USRNAM,COMP,2)_COMP_COMP_COMP
|
---|
| 66 | S USERID=USERID_COMP_COMP_COMP_"USVHA"_SUBCOMP_SUBCOMP_"0363"_COMP_"L"
|
---|
| 67 | S USERID=USERID_COMP_COMP_COMP_"NI"_COMP_"VA FACILITY ID"_SUBCOMP
|
---|
| 68 | S USERID=USERID_$P($$SITE^VASITE,"^",3)_SUBCOMP_"L"
|
---|
| 69 | S $P(EVN,HLFS,6)=USERID,$P(EVN,HLFS,8)=$P($$SITE^VASITE,HLFS,3)
|
---|
| 70 | Q EVN
|
---|
| 71 | ;
|
---|
| 72 | PID(DFN,HL,DGPID) ;Build PID segment
|
---|
| 73 | ;Input: DFN - Patient DFN
|
---|
| 74 | ; HL - HL7 values
|
---|
| 75 | ;Output: DGPIR - PID array segment
|
---|
| 76 | ; 1 - PID segment build (no error)
|
---|
| 77 | ; -1^ErrorText on error
|
---|
| 78 | ;
|
---|
| 79 | N FLDS,DGX
|
---|
| 80 | I $G(DFN)="" Q "-1^Value missing to build message (PID segment)"
|
---|
| 81 | S FLDS=$$COMMANUM^VAFCADT2(1,9)_",10NTB,11,"
|
---|
| 82 | S FLDS=FLDS_$$COMMANUM^VAFCADT2(12,21)_",22B"
|
---|
| 83 | D BLDPID^VAFCQRY(DFN,"",FLDS,.DGPID,.HL)
|
---|
| 84 | S DGX=$O(DGPID(0)) I DGX S DGX=DGPID(DGX)
|
---|
| 85 | I $P(DGX,"^")'="PID" Q "-1^Error build message (PID segment)"
|
---|
| 86 | Q 1
|
---|
| 87 | ;
|
---|
| 88 | PD1(DFN,COORD) ;Build PD1 segment
|
---|
| 89 | ;Input: DFN - Patient DFN
|
---|
| 90 | ; COOR - Care Coordinator
|
---|
| 91 | ;Output: PD1 - PD1 segment
|
---|
| 92 | ; -1^ErrorText on error
|
---|
| 93 | ;
|
---|
| 94 | N PD1,DGNAME
|
---|
| 95 | I $G(DFN)=""!($G(COORD)="") Q "-1^Value missing to build message (PD1 segment)"
|
---|
| 96 | S PD1=$$EN^VAFHLPD1(DFN,3)
|
---|
| 97 | I ($E(PD1,1,3)'="PD1") Q "-1^Error build message (PD1 segment)"
|
---|
| 98 | S DGNAME("FILE")=200,DGNAME("IENS")=COORD,DGNAME("FIELD")=.01
|
---|
| 99 | S $P(PD1,HLFS,5)=COORD_$E(HLECH)_$$HLNAME^XLFNAME(.DGNAME,"",$E(HLECH))
|
---|
| 100 | Q PD1
|
---|
| 101 | ;
|
---|
| 102 | PIDVAL ;validate PID segment
|
---|
| 103 | ;locate the fields in variable FLDS in VAFPID array, check its not null
|
---|
| 104 | N NSTR,STR,FLN,FLDS,FLC,X,Y,Z
|
---|
| 105 | S FLDS="4^6^8^12^20",(FLN,FLN(0))=0,DGX=0
|
---|
| 106 | S STR="Patient Identifier list^Patient Name^Date of Birth^Patient address^SSN"
|
---|
| 107 | F S DGX=$O(VAFPID(DGX)) Q:'DGX D I ERR Q
|
---|
| 108 | .S FLN(DGX)=$L(VAFPID(DGX),"^")-1,FLC=FLN,FLN=FLN+FLN(DGX)
|
---|
| 109 | .F X=1:1 S Y=$P(FLDS,"^",X) Q:Y="" I Y'="C" D I ERR Q
|
---|
| 110 | ..I Y'>FLN S $P(FLDS,"^",X)="C" D
|
---|
| 111 | ...I FLN(DGX)=FLN S:($P(VAFPID(DGX),"^",Y-FLC)="")!($P(VAFPID(DGX),"^",Y-FLC)="""""") ERR="-1^Error in PID-"_(Y-1)_" field ("_$P(STR,"^",X)_")" Q
|
---|
| 112 | ...S NSTR=$P(VAFPID(DGX-1),"^",FLN(DGX-1)+1)_VAFPID(DGX) I ($P(NSTR,"^",Y-FLC)="")!($P(NSTR,"^",Y-FLC)="""""") S ERR="-1^Error in PID-"_(Y-1)_" field ("_$P(STR,"^",X)_")" Q
|
---|
| 113 | Q
|
---|
| 114 | ;
|
---|
| 115 | BLDHL7I(DFN,MSG) ;Build HL7 Registration message for telehealth
|
---|
| 116 | ;Input : DFN - Pointer to PATIENT
|
---|
| 117 | ; MSG - Array to put message into (full global ref)
|
---|
| 118 | ;Output: Last line number used
|
---|
| 119 | ; -1^ErrorText on error
|
---|
| 120 | ; MSG will contain HL7 message
|
---|
| 121 | ;Notes : Insertion into MSG begins at next available line number
|
---|
| 122 | I '$D(^DPT(DFN,0)) Q "-1^Bad input (DFN)"
|
---|
| 123 | I $G(MSG)="" Q "-1^Bad input variable (MSG)"
|
---|
| 124 | N HLFS,HLECH,HLQ,HL,EVN,VAFPID,PV1,LINE,FLDS,DGVEN,DGX
|
---|
| 125 | N EVNTDT,ERR,PROT4HL7,COMP,SUBCOMP,USRNAM,USERID
|
---|
| 126 | S PROT4HL7="DG HOME TELEHEALTH ADT-A03 SERVER"
|
---|
| 127 | D INIT^HLFNC2(PROT4HL7,.HL)
|
---|
| 128 | I ($O(HL(""))="") Q "-1^Unable to initialize HL7 variables"
|
---|
| 129 | S EVNTDT=$$NOW^XLFDT()
|
---|
| 130 | S LINE=+$O(@MSG@(""),-1)
|
---|
| 131 | ;EVN segment
|
---|
| 132 | S EVN=$$EVN("A03","A03",EVNTDT)
|
---|
| 133 | I EVN<0 K @MSG Q "-1^Error build message (EVN segment)"
|
---|
| 134 | S LINE=LINE+1
|
---|
| 135 | S @MSG@(LINE)=EVN
|
---|
| 136 | ;
|
---|
| 137 | ;PID segment
|
---|
| 138 | N DGX
|
---|
| 139 | S PID=$$PID(DGDFN,.HL,.VAFPID)
|
---|
| 140 | I +PID'>0 S ERR=1 K @MSG Q "-1^Error build message (PID segment)"
|
---|
| 141 | S DGX=$O(VAFPID(0)),LINE=LINE+1 S @MSG@(LINE)=VAFPID(DGX)
|
---|
| 142 | F S DGX=$O(VAFPID(DGX)) Q:'DGX D
|
---|
| 143 | .S @MSG@(LINE,DGX-1)=VAFPID(DGX)
|
---|
| 144 | ;Done
|
---|
| 145 | Q 1
|
---|
| 146 | SNDHL7(MSG,PTRRCV,PROTNAME) ;Send HL7 Home Telehealth message to server
|
---|
| 147 | ;Input : MSG - Array containing HL7 message to transmit
|
---|
| 148 | ; (full global reference)
|
---|
| 149 | ; - Must be in format required for interaction
|
---|
| 150 | ; with the HL7 package
|
---|
| 151 | ; PTRRCV - Pointer for vendor receiving system
|
---|
| 152 | ; PROTNAME - Protocol name
|
---|
| 153 | ;Output: Message ID
|
---|
| 154 | ; Message ID or 0^ErrorText on error
|
---|
| 155 | ;Notes : The global array ^TMP("HLS",$J) will be KILLed if MSG
|
---|
| 156 | ; does not use this global location
|
---|
| 157 | I $G(MSG)="" Q "-1^Bad input variable(MSG)"
|
---|
| 158 | I '$G(PTRRCV) Q "-1^Bad input variable for vendor (PTRRCV)"
|
---|
| 159 | I ($O(@MSG@(""))="") Q "-1^Message empty... can't send empty"
|
---|
| 160 | N DGARRAY,HL,HLL,HLFS,HLECH,HLQ,HLMTIEN,HLRESLT,HLP,KILLARRY,ARRY4HL7,APPINFO,DIC,CLPROT,SIEN,LINK
|
---|
| 161 | S ARRY4HL7=$NA(^TMP("HLS",$J))
|
---|
| 162 | D INIT^HLFNC2(PROTNAME,.HL)
|
---|
| 163 | I ($O(HL(""))="") Q "-1^Unable to initialize HL7 variables"
|
---|
| 164 | S APPINFO=$$APP4MSH(PTRRCV)
|
---|
| 165 | I APPINFO="" Q "-1^Unable to determine receiving system information"
|
---|
| 166 | ;See if MSG is ^TMP("HLS",$J)
|
---|
| 167 | S KILLARRY=0
|
---|
| 168 | I (MSG'=ARRY4HL7) D
|
---|
| 169 | .;Make sure '$J' wasn't used
|
---|
| 170 | .Q:(MSG="^TMP(""HLS"",$J)")
|
---|
| 171 | .;Initialize ^TMP("HLS",$J) and merge XMITARRY into it
|
---|
| 172 | .K @ARRY4HL7
|
---|
| 173 | .M @ARRY4HL7=@MSG
|
---|
| 174 | .S KILLARRY=1
|
---|
| 175 | ;Using dynamic MSH segment
|
---|
| 176 | S $P(HLP("SUBSCRIBER"),"^",2)="DG HOME TELEHEALTH"
|
---|
| 177 | S $P(HLP("SUBSCRIBER"),"^",3)=$P(APPINFO,"^",1)
|
---|
| 178 | S $P(HLP("SUBSCRIBER"),"^",4)="HTAPPL"
|
---|
| 179 | S $P(HLP("SUBSCRIBER"),"^",5)=$P(APPINFO,"^",2)
|
---|
| 180 | S HLP("PRIORITY")="I" ;Immediate priority
|
---|
| 181 | ;Get subscriber protocol
|
---|
| 182 | S DIC="^ORD(101,",DIC(0)="B",X=PROTNAME D ^DIC
|
---|
| 183 | D GETS^DIQ(101,+Y,"775*","E","ARRAY1")
|
---|
| 184 | S CLPROT=ARRAY1(101.0775,$O(ARRAY1(101.0775,0)),.01,"E")
|
---|
| 185 | ;Use inst file ien to retrieve logical link for dynamic addressing
|
---|
| 186 | D LINK^HLUTIL3(DGVEN,.DGARRAY,"")
|
---|
| 187 | S LINK=DGARRAY($O(DGARRAY(0)))
|
---|
| 188 | S HLL("LINKS",1)=CLPROT_U_LINK
|
---|
| 189 | D GENERATE^HLMA(PROTNAME,"GM",1,.HLRESLT,"",.HLP)
|
---|
| 190 | ;S:('HLRESLT) HLRESLT=$P(HLRESLT,"^",2,3)
|
---|
| 191 | ;Delete ^TMP("HLS",$J) if MSG was different
|
---|
| 192 | K:(KILLARRY) @ARRY4HL7
|
---|
| 193 | ;Done
|
---|
| 194 | Q HLRESLT
|
---|
| 195 | ;
|
---|
| 196 | APP4MSH(PTRRCV) ;Determine sending and receiving application for MSH segment
|
---|
| 197 | ;Input : PTRRCV = Pointer to file #4 for receiving system
|
---|
| 198 | ;Output: Sending Facility ^ Receiving Facility
|
---|
| 199 | ; Null = Error/bad input
|
---|
| 200 | N SNDFAC,RCVFAC
|
---|
| 201 | I 'PTRRCV Q ""
|
---|
| 202 | I $$GET1^DIQ(4,PTRRCV,.01)="" Q ""
|
---|
| 203 | S SNDFAC=$P($$SITE^VASITE(),"^",3)_$E(HLECH)
|
---|
| 204 | S SNDFAC=SNDFAC_$$GET1^DIQ(4,$P($$SITE^VASITE(),"^"),60,"E")_$E(HLECH)
|
---|
| 205 | S SNDFAC=SNDFAC_"DNS"
|
---|
| 206 | S RCVFAC=$$GET1^DIQ(4,PTRRCV,99,"E")_$E(HLECH)
|
---|
| 207 | S RCVFAC=RCVFAC_$$GET1^DIQ(4,PTRRCV,60,"E")_$E(HLECH)_"DNS"
|
---|
| 208 | Q SNDFAC_"^"_RCVFAC
|
---|