DGHTINAC ;ALB/JRC/JAM - Home Telehealth Patient Inactivation HL7;10 January 2005 ; 11/14/06 9:46am
;;5.3;Registration;**644**;Aug 13, 1993;Build 11
;;
EN ;Main entry point
;Initiate variables
N STOP,ARR,DGTYPE,DGDUZ,FLG
N CNT,DGDFN,DGVEN,NODE,NODE1,MSGTYPE,INACTDT,IRECORD,INODE,DGEVNT
N INAMSGID,ACKCODE,TINACTDT,DGVEN,DGCOOR,DGDATE,VENDOR,CHOICES
N ARECORD,NUMBER,TMPNODE,ITRANS,INODE,DGMID,RESULT,GETOK,DIR,RECORD
S ARR=$NA(HLA("HLS")),DGTYPE="I",DGDUZ=DUZ
S STOP=0
F D Q:STOP
.K ^TMP("DGHT",$J),CHOICES
.S (DGVEN,RECORD,CNT,FLG,ITRANS)=0
.W !!
.;Select patient
.S DGDFN=$$GETPAT()
.I 'DGDFN S STOP=1 Q
.;Get active patient's home telehealth records
.F S DGVEN=$O(^DGHT(391.31,"APATVN",DGDFN,DGVEN)) Q:'DGVEN D
..S ARECORD=$$LOCREC(DGDFN,DGVEN,"A")
..Q:'(ARECORD)
..;Get 0'th node of activation record and 0'th node of transaction
..S NODE=$G(^DGHT(391.31,$P(ARECORD,U,1),0))
..S NODE1=$G(^DGHT(391.31,+$P(ARECORD,U,1),"TRAN",+$P(ARECORD,U,2),0))
..Q:$P(NODE1,U,7)'="A"
..S IRECORD=$$LOCREC(DGDFN,DGVEN,"I")
..Q:'+IRECORD
..S MSGTYPE=$P($G(NODE1),U,4),INACTDT=$P($G(NODE),U,7)
..;Get Inactivation transaction node if exist
..S INODE=$G(^DGHT(391.31,+$P(IRECORD,U,1),"TRAN",+$P(IRECORD,U,2),0))
..S INAMSGID=$P(INODE,U,2),ACKCODE=$P(INODE,U,7),TINACTDT=$P(INODE,U,1)
..I $P($G(INODE),U,7)="A" Q
..;Increment counter
..S CNT=CNT+1
..;Store records in temporary global
..;
..; ^TMP NODE - Record # ^ Transaction # ^ patient ^ vendor ^
..; trans date ^ coordinator ^ trans type ^ inactiva
..; tio date ^ inact msg id ^ inact msg ack code ^
..; trans inactivation date and time ^ inact record
..;
..S DGVEN=$P(NODE,U,3),DGCOOR=$P(NODE,U,5),DGDATE=$P(NODE,U,6)
..S ^TMP("DGHT",$J,CNT,$P(ARECORD,U,1))=ARECORD_U_DGDFN_U_DGVEN_U_DGDATE_U_DGCOOR_U_MSGTYPE_U_INACTDT_U_$G(INAMSGID)_U_$G(ACKCODE)_U_$G(TINACTDT)_U_$TR(IRECORD,U,"~")
..;If more than one record prepare CHOICES variable for DIR call
..S VENDOR=$$GET1^DIQ(4,$P(NODE,U,3),.01,"E")
..S CHOICES=$G(CHOICES)_CNT_":"_$TR($$FMTE^XLFDT(DGDATE,"1HM"),":","")_" "_VENDOR_";"
..;If more than one active HTH record prompt user for selection
.I CNT>1 D Q:FLG
..;Resolve external value for PATIENT
..W !!,"Patient "_$$GET1^DIQ(2,DGDFN,.01,"E")_" has multiple active records"
..K DIR,X,Y,DIRUT,DUOUT
..S DIR(0)="S^"_CHOICES
..S DIR("A")="Select Sign-up/Activation record to Inactivate"
..D ^DIR
..I $D(DIRUT)!$D(DUOUT) S FLG=1 Q
..S NUMBER=Y
..S RECORD=0,RECORD=$O(^TMP("DGHT",$J,NUMBER,RECORD))
..S TMPNODE=^TMP("DGHT",$J,NUMBER,RECORD),IRECORD=$P(TMPNODE,U,12)
.;If there is only one record suppress choices
.I CNT=1 D
..S NUMBER=CNT
..S RECORD=0,RECORD=$O(^TMP("DGHT",$J,NUMBER,RECORD))
..S TMPNODE=^TMP("DGHT",$J,CNT,RECORD),IRECORD=$P(TMPNODE,U,12)
.;If no active records
.I 'CNT D Q:FLG
..W !
..W !,"************************************************************"
..W !,"* THIS PATIENT HAS NO ACTIVE HOME TELEHEALTH RECORDS *"
..W !,"************************************************************"
..S FLG=1
.;Display patient's record information to screen
.W @IOF
.W !!,"THE FOLLOWING PATIENT'S HOME TELEHEALTH RECORD WILL BE INACTIVATED"
.W !!
.D DSPREC^DGHTENR($P(TMPNODE,U,1,2))
.;If patient's record was previously inactivated display information
.I +$P(IRECORD,"~",2)'="" D
..W !,"Patient's inactivation was previously transmitted on:"
..W !!,?3,"Date & Time: ",?21,$$FMTE^XLFDT($P(TMPNODE,U,11),"2")
..W !,?3,"Message ID: ",?21,$P(TMPNODE,U,9)
..W !,?3,"Acknowledge Code: ",?21,$S($P(TMPNODE,U,10)="R":"Rejected",$P(TMPNODE,U,10)="A":"Accepted",1:"")
..W !!
.;Prompt user for inactivation date
.K DIR,X,Y,DIRUT,DUOUT
.S DIR(0)="D^::ERTXS"
.S DIR("A")="Enter Inactivation Date & Time"
.S DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT())
.D ^DIR
.I $D(DIRUT)!$D(DUOUT) D EXIT Q
.S DGEVNT=Y
.;Get okay for tansmission
.S GETOK=$$SNDMSG^DGHTENR(DGTYPE)
.I 'GETOK W " ...Patient record not transmitted." D EXIT Q
.;Set variables and validate
.S DGVEN=$P(TMPNODE,U,4),DGDATE=$P(TMPNODE,U,5)
.S DGCOOR=$P(TMPNODE,U,6),TINACTDT=$P(TMPNODE,U,10)
.;build message
.W !!,"Generating message ..."
.K @ARR
.S RESULT=$$BLDHL7I^DGHTHL7(DGDFN,ARR)
.I RESULT<0 D Q
..W !,"** UNABLE TO BUILD MESSAGE **"
..W !,$P(RESULT,"^",2)
..K @ARR
.I RESULT=0 D Q
..W !,"** EMPTY MESSAGE BUILT **"
..K @ARR
.;send message
.W !,"Sending message ..."
.S RESULT=$$SNDHL7^DGHTHL7(ARR,DGVEN,"DG HOME TELEHEALTH ADT-A03 SERVER")
.I RESULT<0 D Q
..W !,"** UNABLE TO SEND MESSAGE **"
..W !,$P(RESULT,"^",2)
..K @ARR
.W !,"Sent using message ID ",+RESULT
.S DGMID=$P(RESULT,U,1)
.K @ARR
.D FILE
D EXIT
Q
;
GETPAT() ;Prompt user for patient
;Input : None
;Output: Pointer to PATIENT File, #2 (i.e. DFN)
; 0 on user quit
N DIC,X,Y,DTOUT,DUOUT
S DIC="^DPT(",DIC("A")="Patient: "
S DIC(0)="AEQM"
S DIC("S")="I $D(^DGHT(391.31,""APATVN"",+Y))"
D ^DIC
Q $S(+Y<0:0,1:+Y)
;
FILE ;Update Home Telehealth File Inactivation
N DGHFDA,DGHERR,FLDS,DA
;Remove old inactivation entry in transaction subfile
I +$P(IRECORD,"~",2) D
.N DIK S DA(1)=+$P(IRECORD,"~",1),DA=+$P(IRECORD,"~",2)
.S DIK="^DGHT(391.31,"_DA(1)_",""TRAN"","
.D ^DIK
;Update subfile 391.317 Transaction
K DGHFDA,DGHERR
S DGHFDA(391.317,"+2,"_RECORD_",",.01)=DGEVNT
S DGHFDA(391.317,"+2,"_RECORD_",",.02)=DGMID
S DGHFDA(391.317,"+2,"_RECORD_",",.03)=DGDUZ
S DGHFDA(391.317,"+2,"_RECORD_",",.04)=DGTYPE
D UPDATE^DIE("","DGHFDA","","DGHERR")
I $D(DGHERR) D
.W !!!,"Problem encountered during record update "
.W !!,"Contact IRM"_" Error: "_$G(DGHERR("DIERR",1,"TEXT",1))
Q
;
LOCREC(DFN,VENDOR,TYPE) ;Locate the appropriate record pointer(s) for processing
;Input : DFN - Patient DFN
; VENDOR - Vendor IEN
; TYPE - A for Activation/Sign-up or I for Inactivation
;Output: Record IEN^transaction IEN (if available)
; flag 1 = Patient record was located
; 0 = No record was located.
;
;If TYPE="A" and record has inactivation date then nothing will be
; returned, record is consider closed.
; TYPE="I" and transaction level record was accepted,then nothing
; will be returned, record is consider closed.
;
I ($G(DFN)="")!($G(VENDOR)="")!($G(TYPE)="") Q 0
N IEN,IEN1,DGDAT,DGDAT1,FND,FND1
S (IEN,FND,FND1)=0
F S IEN=$O(^DGHT(391.31,"APATVN",DFN,VENDOR,IEN)) Q:'IEN D I FND Q
.S DGDAT=$G(^DGHT(391.31,IEN,0)) I DGDAT="" Q
.Q:$P(DGDAT,"^",7)'=""
.;I TYPE="A" Q:$P(DGDAT,"^",7)'=""
.;I TYPE="I",$P(DGDAT,"^",7)="" S FND=IEN Q
.S IEN1=0 F S IEN1=$O(^DGHT(391.31,IEN,"TRAN",IEN1)) Q:'IEN1 D Q:+FND1
..S DGDAT1=$G(^DGHT(391.31,IEN,"TRAN",IEN1,0)) Q:DGDAT1=""
..I $P(DGDAT1,"^",4)'=$E(TYPE) Q
..I TYPE="I",$P(DGDAT1,"^",7)="A" Q
..S FND1=IEN1
.S FND=IEN_$S(IEN1:"^"_IEN1,1:"")
Q FND
;
EXIT ;Kill array
K ^TMP("DGHT",$J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGHTINAC 7063 printed Sep 23, 2025@20:19:38 Page 2
DGHTINAC ;ALB/JRC/JAM - Home Telehealth Patient Inactivation HL7;10 January 2005 ; 11/14/06 9:46am
+1 ;;5.3;Registration;**644**;Aug 13, 1993;Build 11
+2 ;;
EN ;Main entry point
+1 ;Initiate variables
+2 NEW STOP,ARR,DGTYPE,DGDUZ,FLG
+3 NEW CNT,DGDFN,DGVEN,NODE,NODE1,MSGTYPE,INACTDT,IRECORD,INODE,DGEVNT
+4 NEW INAMSGID,ACKCODE,TINACTDT,DGVEN,DGCOOR,DGDATE,VENDOR,CHOICES
+5 NEW ARECORD,NUMBER,TMPNODE,ITRANS,INODE,DGMID,RESULT,GETOK,DIR,RECORD
+6 SET ARR=$NAME(HLA("HLS"))
SET DGTYPE="I"
SET DGDUZ=DUZ
+7 SET STOP=0
+8 FOR
Begin DoDot:1
+9 KILL ^TMP("DGHT",$JOB),CHOICES
+10 SET (DGVEN,RECORD,CNT,FLG,ITRANS)=0
+11 WRITE !!
+12 ;Select patient
+13 SET DGDFN=$$GETPAT()
+14 IF 'DGDFN
SET STOP=1
QUIT
+15 ;Get active patient's home telehealth records
+16 FOR
SET DGVEN=$ORDER(^DGHT(391.31,"APATVN",DGDFN,DGVEN))
if 'DGVEN
QUIT
Begin DoDot:2
+17 SET ARECORD=$$LOCREC(DGDFN,DGVEN,"A")
+18 if '(ARECORD)
QUIT
+19 ;Get 0'th node of activation record and 0'th node of transaction
+20 SET NODE=$GET(^DGHT(391.31,$PIECE(ARECORD,U,1),0))
+21 SET NODE1=$GET(^DGHT(391.31,+$PIECE(ARECORD,U,1),"TRAN",+$PIECE(ARECORD,U,2),0))
+22 if $PIECE(NODE1,U,7)'="A"
QUIT
+23 SET IRECORD=$$LOCREC(DGDFN,DGVEN,"I")
+24 if '+IRECORD
QUIT
+25 SET MSGTYPE=$PIECE($GET(NODE1),U,4)
SET INACTDT=$PIECE($GET(NODE),U,7)
+26 ;Get Inactivation transaction node if exist
+27 SET INODE=$GET(^DGHT(391.31,+$PIECE(IRECORD,U,1),"TRAN",+$PIECE(IRECORD,U,2),0))
+28 SET INAMSGID=$PIECE(INODE,U,2)
SET ACKCODE=$PIECE(INODE,U,7)
SET TINACTDT=$PIECE(INODE,U,1)
+29 IF $PIECE($GET(INODE),U,7)="A"
QUIT
+30 ;Increment counter
+31 SET CNT=CNT+1
+32 ;Store records in temporary global
+33 ;
+34 ; ^TMP NODE - Record # ^ Transaction # ^ patient ^ vendor ^
+35 ; trans date ^ coordinator ^ trans type ^ inactiva
+36 ; tio date ^ inact msg id ^ inact msg ack code ^
+37 ; trans inactivation date and time ^ inact record
+38 ;
+39 SET DGVEN=$PIECE(NODE,U,3)
SET DGCOOR=$PIECE(NODE,U,5)
SET DGDATE=$PIECE(NODE,U,6)
+40 SET ^TMP("DGHT",$JOB,CNT,$PIECE(ARECORD,U,1))=ARECORD_U_DGDFN_U_DGVEN_U_DGDATE_U_DGCOOR_U_MSGTYPE_U_INACTDT_U_$GET(INAMSGID)_U_$GET(ACKCODE)_U_$GET(TINACTDT)_U_$TRANSLATE(IRECORD,U,"~")
+41 ;If more than one record prepare CHOICES variable for DIR call
+42 SET VENDOR=$$GET1^DIQ(4,$PIECE(NODE,U,3),.01,"E")
+43 SET CHOICES=$GET(CHOICES)_CNT_":"_$TRANSLATE($$FMTE^XLFDT(DGDATE,"1HM"),":","")_" "_VENDOR_";"
+44 ;If more than one active HTH record prompt user for selection
End DoDot:2
+45 IF CNT>1
Begin DoDot:2
+46 ;Resolve external value for PATIENT
+47 WRITE !!,"Patient "_$$GET1^DIQ(2,DGDFN,.01,"E")_" has multiple active records"
+48 KILL DIR,X,Y,DIRUT,DUOUT
+49 SET DIR(0)="S^"_CHOICES
+50 SET DIR("A")="Select Sign-up/Activation record to Inactivate"
+51 DO ^DIR
+52 IF $DATA(DIRUT)!$DATA(DUOUT)
SET FLG=1
QUIT
+53 SET NUMBER=Y
+54 SET RECORD=0
SET RECORD=$ORDER(^TMP("DGHT",$JOB,NUMBER,RECORD))
+55 SET TMPNODE=^TMP("DGHT",$JOB,NUMBER,RECORD)
SET IRECORD=$PIECE(TMPNODE,U,12)
End DoDot:2
if FLG
QUIT
+56 ;If there is only one record suppress choices
+57 IF CNT=1
Begin DoDot:2
+58 SET NUMBER=CNT
+59 SET RECORD=0
SET RECORD=$ORDER(^TMP("DGHT",$JOB,NUMBER,RECORD))
+60 SET TMPNODE=^TMP("DGHT",$JOB,CNT,RECORD)
SET IRECORD=$PIECE(TMPNODE,U,12)
End DoDot:2
+61 ;If no active records
+62 IF 'CNT
Begin DoDot:2
+63 WRITE !
+64 WRITE !,"************************************************************"
+65 WRITE !,"* THIS PATIENT HAS NO ACTIVE HOME TELEHEALTH RECORDS *"
+66 WRITE !,"************************************************************"
+67 SET FLG=1
End DoDot:2
if FLG
QUIT
+68 ;Display patient's record information to screen
+69 WRITE @IOF
+70 WRITE !!,"THE FOLLOWING PATIENT'S HOME TELEHEALTH RECORD WILL BE INACTIVATED"
+71 WRITE !!
+72 DO DSPREC^DGHTENR($PIECE(TMPNODE,U,1,2))
+73 ;If patient's record was previously inactivated display information
+74 IF +$PIECE(IRECORD,"~",2)'=""
Begin DoDot:2
+75 WRITE !,"Patient's inactivation was previously transmitted on:"
+76 WRITE !!,?3,"Date & Time: ",?21,$$FMTE^XLFDT($PIECE(TMPNODE,U,11),"2")
+77 WRITE !,?3,"Message ID: ",?21,$PIECE(TMPNODE,U,9)
+78 WRITE !,?3,"Acknowledge Code: ",?21,$SELECT($PIECE(TMPNODE,U,10)="R":"Rejected",$PIECE(TMPNODE,U,10)="A":"Accepted",1:"")
+79 WRITE !!
End DoDot:2
+80 ;Prompt user for inactivation date
+81 KILL DIR,X,Y,DIRUT,DUOUT
+82 SET DIR(0)="D^::ERTXS"
+83 SET DIR("A")="Enter Inactivation Date & Time"
+84 SET DIR("B")=$$FMTE^XLFDT($$NOW^XLFDT())
+85 DO ^DIR
+86 IF $DATA(DIRUT)!$DATA(DUOUT)
DO EXIT
QUIT
+87 SET DGEVNT=Y
+88 ;Get okay for tansmission
+89 SET GETOK=$$SNDMSG^DGHTENR(DGTYPE)
+90 IF 'GETOK
WRITE " ...Patient record not transmitted."
DO EXIT
QUIT
+91 ;Set variables and validate
+92 SET DGVEN=$PIECE(TMPNODE,U,4)
SET DGDATE=$PIECE(TMPNODE,U,5)
+93 SET DGCOOR=$PIECE(TMPNODE,U,6)
SET TINACTDT=$PIECE(TMPNODE,U,10)
+94 ;build message
+95 WRITE !!,"Generating message ..."
+96 KILL @ARR
+97 SET RESULT=$$BLDHL7I^DGHTHL7(DGDFN,ARR)
+98 IF RESULT<0
Begin DoDot:2
+99 WRITE !,"** UNABLE TO BUILD MESSAGE **"
+100 WRITE !,$PIECE(RESULT,"^",2)
+101 KILL @ARR
End DoDot:2
QUIT
+102 IF RESULT=0
Begin DoDot:2
+103 WRITE !,"** EMPTY MESSAGE BUILT **"
+104 KILL @ARR
End DoDot:2
QUIT
+105 ;send message
+106 WRITE !,"Sending message ..."
+107 SET RESULT=$$SNDHL7^DGHTHL7(ARR,DGVEN,"DG HOME TELEHEALTH ADT-A03 SERVER")
+108 IF RESULT<0
Begin DoDot:2
+109 WRITE !,"** UNABLE TO SEND MESSAGE **"
+110 WRITE !,$PIECE(RESULT,"^",2)
+111 KILL @ARR
End DoDot:2
QUIT
+112 WRITE !,"Sent using message ID ",+RESULT
+113 SET DGMID=$PIECE(RESULT,U,1)
+114 KILL @ARR
+115 DO FILE
End DoDot:1
if STOP
QUIT
+116 DO EXIT
+117 QUIT
+118 ;
GETPAT() ;Prompt user for patient
+1 ;Input : None
+2 ;Output: Pointer to PATIENT File, #2 (i.e. DFN)
+3 ; 0 on user quit
+4 NEW DIC,X,Y,DTOUT,DUOUT
+5 SET DIC="^DPT("
SET DIC("A")="Patient: "
+6 SET DIC(0)="AEQM"
+7 SET DIC("S")="I $D(^DGHT(391.31,""APATVN"",+Y))"
+8 DO ^DIC
+9 QUIT $SELECT(+Y<0:0,1:+Y)
+10 ;
FILE ;Update Home Telehealth File Inactivation
+1 NEW DGHFDA,DGHERR,FLDS,DA
+2 ;Remove old inactivation entry in transaction subfile
+3 IF +$PIECE(IRECORD,"~",2)
Begin DoDot:1
+4 NEW DIK
SET DA(1)=+$PIECE(IRECORD,"~",1)
SET DA=+$PIECE(IRECORD,"~",2)
+5 SET DIK="^DGHT(391.31,"_DA(1)_",""TRAN"","
+6 DO ^DIK
End DoDot:1
+7 ;Update subfile 391.317 Transaction
+8 KILL DGHFDA,DGHERR
+9 SET DGHFDA(391.317,"+2,"_RECORD_",",.01)=DGEVNT
+10 SET DGHFDA(391.317,"+2,"_RECORD_",",.02)=DGMID
+11 SET DGHFDA(391.317,"+2,"_RECORD_",",.03)=DGDUZ
+12 SET DGHFDA(391.317,"+2,"_RECORD_",",.04)=DGTYPE
+13 DO UPDATE^DIE("","DGHFDA","","DGHERR")
+14 IF $DATA(DGHERR)
Begin DoDot:1
+15 WRITE !!!,"Problem encountered during record update "
+16 WRITE !!,"Contact IRM"_" Error: "_$GET(DGHERR("DIERR",1,"TEXT",1))
End DoDot:1
+17 QUIT
+18 ;
LOCREC(DFN,VENDOR,TYPE) ;Locate the appropriate record pointer(s) for processing
+1 ;Input : DFN - Patient DFN
+2 ; VENDOR - Vendor IEN
+3 ; TYPE - A for Activation/Sign-up or I for Inactivation
+4 ;Output: Record IEN^transaction IEN (if available)
+5 ; flag 1 = Patient record was located
+6 ; 0 = No record was located.
+7 ;
+8 ;If TYPE="A" and record has inactivation date then nothing will be
+9 ; returned, record is consider closed.
+10 ; TYPE="I" and transaction level record was accepted,then nothing
+11 ; will be returned, record is consider closed.
+12 ;
+13 IF ($GET(DFN)="")!($GET(VENDOR)="")!($GET(TYPE)="")
QUIT 0
+14 NEW IEN,IEN1,DGDAT,DGDAT1,FND,FND1
+15 SET (IEN,FND,FND1)=0
+16 FOR
SET IEN=$ORDER(^DGHT(391.31,"APATVN",DFN,VENDOR,IEN))
if 'IEN
QUIT
Begin DoDot:1
+17 SET DGDAT=$GET(^DGHT(391.31,IEN,0))
IF DGDAT=""
QUIT
+18 if $PIECE(DGDAT,"^",7)'=""
QUIT
+19 ;I TYPE="A" Q:$P(DGDAT,"^",7)'=""
+20 ;I TYPE="I",$P(DGDAT,"^",7)="" S FND=IEN Q
+21 SET IEN1=0
FOR
SET IEN1=$ORDER(^DGHT(391.31,IEN,"TRAN",IEN1))
if 'IEN1
QUIT
Begin DoDot:2
+22 SET DGDAT1=$GET(^DGHT(391.31,IEN,"TRAN",IEN1,0))
if DGDAT1=""
QUIT
+23 IF $PIECE(DGDAT1,"^",4)'=$EXTRACT(TYPE)
QUIT
+24 IF TYPE="I"
IF $PIECE(DGDAT1,"^",7)="A"
QUIT
+25 SET FND1=IEN1
End DoDot:2
if +FND1
QUIT
+26 SET FND=IEN_$SELECT(IEN1:"^"_IEN1,1:"")
End DoDot:1
IF FND
QUIT
+27 QUIT FND
+28 ;
EXIT ;Kill array
+1 KILL ^TMP("DGHT",$JOB)
+2 QUIT
