source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGHTINAC.m@ 1608

Last change on this file since 1608 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 6.7 KB
RevLine 
[613]1DGHTINAC ;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 ;;
4EN ;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 ;
123GETPAT() ;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 ;
134FILE ;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 ;
153LOCREC(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 ;
182EXIT ;Kill array
183 K ^TMP("DGHT",$J)
184 Q
Note: See TracBrowser for help on using the repository browser.