Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGHTHL7

DGHTHL7.m

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