DGHTHL7 ;ALB/JAM - Home Telehealth Patient Sign-up HL7;10 January 2005 ; 9/25/07 10:18am
 ;;5.3;Registration;**644**;Aug 13, 1993;Build 11
 ;
BLDHL7(DGHTH,MSG) ;Build HL7 Registration message for Home Telehealth
 ;Input : DGHTH - Arry with Home Telehealth transaction data
 ;        MSG   - Array to put message into (full global ref)
 ;Output: N  - Last line number used, or
 ;        0  - no message built, or
 ;        -1^ErrorText on error
 ;        MSG will contain HL7 message
 ;Note  : Insertion into MSG begins at next available line number
 ;
 N DFN,VENDOR,CONSULT,COORD,EVENTDT,VALCHK,DGX,ERR,PROTNAME,VAFPID
 N HLFS,HLECH,HLQ,HL,EVN,PID,PD1,PV1,LINE,X,Y
 S ERR=0,X="" F  S X=$O(DGHTH(X)) Q:X=""  D  I ERR Q
 .I DGHTH(X)="" S VALCHK="-1^Bad Input ("_X_")",ERR=1 Q
 .S @X=DGHTH(X)
 I ERR Q $G(VALCHK)
 I $G(MSG)="" Q "-1^Bad input variable (MSG)"
 S PROTNAME="DG HOME TELEHEALTH ADT-A04 SERVER"
 D INIT^HLFNC2(PROTNAME,.HL)
 I ($O(HL(""))="") Q "-1^Unable to initialize HL7 variables"
 S LINE=+$O(@MSG@(""),-1)
 ;
 ;EVN segment
 S EVN=$$EVN("A04","A04",EVENTDT)
 I $P(EVN,U)=-1 K @MSG Q EVN
 S LINE=LINE+1 S @MSG@(LINE)=EVN
 ;
 ;PID segment
 S PID=$$PID(DFN,.HL,.VAFPID)
 I $P(PID,U)=-1 Q PID
 D PIDVAL I ERR Q ERR
 S DGX=$O(VAFPID(0)),LINE=LINE+1 S @MSG@(LINE)=VAFPID(DGX)
 F  S DGX=$O(VAFPID(DGX)) Q:'DGX  D
 .S @MSG@(LINE,DGX-1)=VAFPID(DGX)
 ;
 ;PD1 segment
 S PD1=$$PD1(DFN,COORD)
 I $P(PD1,U)=-1 Q PD1
 S LINE=LINE+1 S @MSG@(LINE)=PD1
 ;
 ;PV1 segment
 S $P(PV1,HLFS,1)=1,$P(PV1,HLFS,5)=CONSULT
 S $P(PV1,HLFS,39)=$$STA^XUAF4(DUZ(2))
 S PV1="PV1"_HLFS_PV1
 S LINE=LINE+1 S @MSG@(LINE)=PV1
 ;
 Q LINE
 ;
EVN(TYPE,FLAG,DGEVDT) ;Build EVN segment
 ;Input:  TYPE   - HL7 event type
 ;        FLAG   - HL7 Event Reason Code
 ;        DGEVDT - Event Date/Time [Optional]
 ;Output: value  - EVN segment
 ;        -1^ErrorText on error
 ;
 N USRNAM,USERID,COMP,SUBCOMP,EVN
 I $G(TYPE)=""!($G(FLAG)="") Q "-1^Value missing to build message (EVN segment)"
 S EVN=$$EVN^VAFHLEVN(TYPE,FLAG,DGEVDT)
 I ($E(EVN,1,3)'="EVN") Q "-1^Error build message (EVN segment)"
 ;Add user and user's facility to EVN segment
 S COMP=$E(HL("ECH"),1),SUBCOMP=$E(HL("ECH"),4)
 S USRNAM=$$HLNAME^HLFNC($$GET1^DIQ(200,DUZ_",",.01),HL("ECH"))
 S USERID=DUZ_COMP_$P(USRNAM,COMP)_COMP_$P(USRNAM,COMP,2)_COMP_COMP_COMP
 S USERID=USERID_COMP_COMP_COMP_"USVHA"_SUBCOMP_SUBCOMP_"0363"_COMP_"L"
 S USERID=USERID_COMP_COMP_COMP_"NI"_COMP_"VA FACILITY ID"_SUBCOMP
 S USERID=USERID_$P($$SITE^VASITE,"^",3)_SUBCOMP_"L"
 S $P(EVN,HLFS,6)=USERID,$P(EVN,HLFS,8)=$P($$SITE^VASITE,HLFS,3)
 Q EVN
 ;
PID(DFN,HL,DGPID) ;Build PID segment
 ;Input:  DFN    - Patient DFN
 ;        HL     - HL7 values
 ;Output: DGPIR  - PID array segment
 ;            1  - PID segment build (no error)
 ;        -1^ErrorText on error
 ;
 N FLDS,DGX
 I $G(DFN)="" Q "-1^Value missing to build message (PID segment)"
 S FLDS=$$COMMANUM^VAFCADT2(1,9)_",10NTB,11,"
 S FLDS=FLDS_$$COMMANUM^VAFCADT2(12,21)_",22B"
 D BLDPID^VAFCQRY(DFN,"",FLDS,.DGPID,.HL)
 S DGX=$O(DGPID(0)) I DGX S DGX=DGPID(DGX)
 I $P(DGX,"^")'="PID" Q "-1^Error build message (PID segment)"
 Q 1
 ;
PD1(DFN,COORD) ;Build PD1 segment
 ;Input:  DFN    - Patient DFN
 ;        COOR   - Care Coordinator
 ;Output: PD1    - PD1 segment
 ;        -1^ErrorText on error
 ;
 N PD1,DGNAME
 I $G(DFN)=""!($G(COORD)="") Q "-1^Value missing to build message (PD1 segment)"
 S PD1=$$EN^VAFHLPD1(DFN,3)
 I ($E(PD1,1,3)'="PD1") Q "-1^Error build message (PD1 segment)"
 S DGNAME("FILE")=200,DGNAME("IENS")=COORD,DGNAME("FIELD")=.01
 S $P(PD1,HLFS,5)=COORD_$E(HLECH)_$$HLNAME^XLFNAME(.DGNAME,"",$E(HLECH))
 Q PD1
 ;
PIDVAL ;validate PID segment
 ;locate the fields in variable FLDS in VAFPID array, check its not null
 N NSTR,STR,FLN,FLDS,FLC,X,Y,Z
 S FLDS="4^6^8^12^20",(FLN,FLN(0))=0,DGX=0
 S STR="Patient Identifier list^Patient Name^Date of Birth^Patient address^SSN"
 F  S DGX=$O(VAFPID(DGX)) Q:'DGX  D  I ERR Q
 .S FLN(DGX)=$L(VAFPID(DGX),"^")-1,FLC=FLN,FLN=FLN+FLN(DGX)
 .F X=1:1 S Y=$P(FLDS,"^",X) Q:Y=""  I Y'="C" D  I ERR Q
 ..I Y'>FLN S $P(FLDS,"^",X)="C" D
 ...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
 ...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
 Q
 ;
BLDHL7I(DFN,MSG) ;Build HL7 Registration message for telehealth
 ;Input : DFN  - Pointer to PATIENT
 ;        MSG  - Array to put message into (full global ref)
 ;Output: Last line number used
 ;        -1^ErrorText on error
 ;        MSG will contain HL7 message
 ;Notes : Insertion into MSG begins at next available line number
 I '$D(^DPT(DFN,0)) Q "-1^Bad input (DFN)"
 I $G(MSG)="" Q "-1^Bad input variable (MSG)"
 N HLFS,HLECH,HLQ,HL,EVN,VAFPID,PV1,LINE,FLDS,DGVEN,DGX
 N EVNTDT,ERR,PROT4HL7,COMP,SUBCOMP,USRNAM,USERID
 S PROT4HL7="DG HOME TELEHEALTH ADT-A03 SERVER"
 D INIT^HLFNC2(PROT4HL7,.HL)
 I ($O(HL(""))="") Q "-1^Unable to initialize HL7 variables"
 S EVNTDT=$$NOW^XLFDT()
 S LINE=+$O(@MSG@(""),-1)
 ;EVN segment
 S EVN=$$EVN("A03","A03",EVNTDT)
 I EVN<0 K @MSG Q "-1^Error build message (EVN segment)"
 S LINE=LINE+1
 S @MSG@(LINE)=EVN
 ;
 ;PID segment
 N DGX
 S PID=$$PID(DGDFN,.HL,.VAFPID)
 I +PID'>0 S ERR=1 K @MSG Q "-1^Error build message (PID segment)"
 S DGX=$O(VAFPID(0)),LINE=LINE+1 S @MSG@(LINE)=VAFPID(DGX)
 F  S DGX=$O(VAFPID(DGX)) Q:'DGX  D
 .S @MSG@(LINE,DGX-1)=VAFPID(DGX)
 ;Done
 Q 1
SNDHL7(MSG,PTRRCV,PROTNAME)     ;Send HL7 Home Telehealth message to server
 ;Input : MSG - Array containing HL7 message to transmit
 ;              (full global reference)
 ;            - Must be in format required for interaction
 ;              with the HL7 package
 ;     PTRRCV  - Pointer for vendor receiving system
 ;    PROTNAME - Protocol name
 ;Output: Message ID
 ;        Message ID or 0^ErrorText on error
 ;Notes  : The global array ^TMP("HLS",$J) will be KILLed if MSG
 ;         does not use this global location
 I $G(MSG)="" Q "-1^Bad input variable(MSG)"
 I '$G(PTRRCV) Q "-1^Bad input variable for vendor (PTRRCV)"
 I ($O(@MSG@(""))="") Q "-1^Message empty... can't send empty"
 N DGARRAY,HL,HLL,HLFS,HLECH,HLQ,HLMTIEN,HLRESLT,HLP,KILLARRY,ARRY4HL7,APPINFO,DIC,CLPROT,SIEN,LINK
 S ARRY4HL7=$NA(^TMP("HLS",$J))
 D INIT^HLFNC2(PROTNAME,.HL)
 I ($O(HL(""))="") Q "-1^Unable to initialize HL7 variables"
 S APPINFO=$$APP4MSH(PTRRCV)
 I APPINFO="" Q "-1^Unable to determine receiving system information"
 ;See if MSG is ^TMP("HLS",$J)
 S KILLARRY=0
 I (MSG'=ARRY4HL7) D
 .;Make sure '$J' wasn't used
 .Q:(MSG="^TMP(""HLS"",$J)")
 .;Initialize ^TMP("HLS",$J) and merge XMITARRY into it
 .K @ARRY4HL7
 .M @ARRY4HL7=@MSG
 .S KILLARRY=1
 ;Using dynamic MSH segment
 S $P(HLP("SUBSCRIBER"),"^",2)="DG HOME TELEHEALTH"
 S $P(HLP("SUBSCRIBER"),"^",3)=$P(APPINFO,"^",1)
 S $P(HLP("SUBSCRIBER"),"^",4)="HTAPPL"
 S $P(HLP("SUBSCRIBER"),"^",5)=$P(APPINFO,"^",2)
 S HLP("PRIORITY")="I"  ;Immediate priority
 ;Get subscriber protocol
 S DIC="^ORD(101,",DIC(0)="B",X=PROTNAME D ^DIC
 D GETS^DIQ(101,+Y,"775*","E","ARRAY1")
 S CLPROT=ARRAY1(101.0775,$O(ARRAY1(101.0775,0)),.01,"E")
 ;Use inst file ien to retrieve logical link for dynamic addressing
 D LINK^HLUTIL3(DGVEN,.DGARRAY,"")
 S LINK=DGARRAY($O(DGARRAY(0)))
 S HLL("LINKS",1)=CLPROT_U_LINK
 D GENERATE^HLMA(PROTNAME,"GM",1,.HLRESLT,"",.HLP)
 ;S:('HLRESLT) HLRESLT=$P(HLRESLT,"^",2,3)
 ;Delete ^TMP("HLS",$J) if MSG was different
 K:(KILLARRY) @ARRY4HL7
 ;Done
 Q HLRESLT
 ;
APP4MSH(PTRRCV) ;Determine sending and receiving application for MSH segment
 ;Input : PTRRCV = Pointer to file #4 for receiving system
 ;Output: Sending Facility ^ Receiving Facility
 ;        Null = Error/bad input
 N SNDFAC,RCVFAC
 I 'PTRRCV Q ""
 I $$GET1^DIQ(4,PTRRCV,.01)="" Q ""
 S SNDFAC=$P($$SITE^VASITE(),"^",3)_$E(HLECH)
 S SNDFAC=SNDFAC_$$GET1^DIQ(4,$P($$SITE^VASITE(),"^"),60,"E")_$E(HLECH)
 S SNDFAC=SNDFAC_"DNS"
 S RCVFAC=$$GET1^DIQ(4,PTRRCV,99,"E")_$E(HLECH)
 S RCVFAC=RCVFAC_$$GET1^DIQ(4,PTRRCV,60,"E")_$E(HLECH)_"DNS"
 Q SNDFAC_"^"_RCVFAC