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