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