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

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

initial load of WorldVistAEHR

File size: 5.7 KB
Line 
1DGHTRPT ;ALB/JRC - Home Telehealth Transmissions Report ; 1/9/06 9:22am
2 ;;5.3;Registration;**644**;Aug 13, 1993;Build 11
3 ;
4EN ;entry point from option
5 ;Declare variable(s) and arrays
6 N DGSD,DGED,I,SCANARR,MSGSTAT,FLAG
7 N ZTDESC,ZTIO,ZTSAVE
8 S FLAG=""
9 ;Prompt for starting and ending date
10 D GETDATES^DGHTRPT1 Q:FLAG
11 ;Get ACK status
12 D GETSTAT Q:FLAG
13 ;Get coordinator(s)
14 D GETCOOR Q:FLAG
15 ;Queue Report
16 S ZTIO=""
17 S ZTDESC="Home Telehealth Transmission Report"
18 F I="DGSD","DGED","SCANARR","MSGSTAT" S ZTSAVE(I)=""
19 D EN^XUTMDEVQ("EN1^DGHTRPT",ZTDESC,.ZTSAVE)
20 Q
21 ;
22EN1 ;Tasked entry point
23 ;Input : DGSD - FM format report start date
24 ; DGED - FM format report end date
25 ;
26 ;Output : None
27 ;
28 ;Declare variables
29 N DGSD1,DGED1,STOP,CNT,LN,PAGENUM,SCRNARR
30 S DGED1=DGED+.9999,DGSD1=DGSD-.0001,(CNT,PAGENUM,STOP)=0
31 S SCRNARR="^TMP(""DGHT"",$J,""SCRNARR"")"
32 K @SCRNARR
33 M @SCRNARR@("PROVIDERS")=SCANARR
34 D HEADER
35 D GETDATA
36 I 'CNT D Q
37 .W !
38 .W !,"***********************************************"
39 .W !,"* NOTHING TO REPORT FOR SELECTED TIME FRAME *"
40 .W !,"***********************************************"
41 .D WAIT
42 D DETAIL I STOP D EXIT Q
43 D TOTAL
44 D EXIT
45 Q
46 ;
47GETSTAT ;Prompt for message status to report
48 N DIR,X,Y
49 S DIR(0)="SC^1:ALL;2:ACCEPTED;3:REJECTED"
50 S DIR("A")="Select message status for report"
51 D ^DIR
52 I $D(DIRUT) S FLAG=1 Q
53 S MSGSTAT=Y
54 Q
55 ;
56GETCOOR ;Prompt for coordinator(s)
57 N DIC,VAUTSTR,VAUTVB,VAUTNI,Y
58 ;Get provider selection
59 S DIC="^VA(200,"
60 S VAUTSTR="CARE COORDINATOR"
61 S VAUTVB="SCANARR"
62 S VAUTNI=2
63 D FIRST^VAUTOMA
64 I Y<0 S FLAG=1 Q
65 Q
66 ;
67GETDATA ;Get data
68 ;Declare variables
69 N PATIENT,SSN,VENDOR,COORD,CONSULT,DATE,MSGID,ACKDATE,STATUS,REJECT
70 N MSGTYPE,STATUS,DGDA0,DGDA1,DG0,DG1
71 F S DGSD1=$O(^DGHT(391.31,"C",DGSD1)) Q:(DGSD1>DGED1)!('DGSD1) D
72 .S DGDA0=0
73 .F S DGDA0=$O(^DGHT(391.31,"C",DGSD1,DGDA0)) Q:'DGDA0 D
74 ..S DGDA1=0
75 ..F S DGDA1=$O(^DGHT(391.31,"C",DGSD1,DGDA0,DGDA1)) Q:'DGDA1 D
76 ...;Get data node and increment conunter
77 ...S DG0=$G(^DGHT(391.31,DGDA0,0))
78 ...Q:DG0=""
79 ...S DG1=$G(^DGHT(391.31,DGDA0,"TRAN",DGDA1,0))
80 ...Q:DG1=""
81 ...S PATIENT=$P(DG0,U,2),VENDOR=$P(DG0,U,3),CONSULT=$P(DG0,U,4)
82 ...S COORD=$P(DG0,U,5),DATE=$P(DG1,U,1),MSGID=$P(DG1,U,2)
83 ...S ACKDATE=$P(DG1,U,6),STATUS=$P(DG1,U,7),REJECT=$P(DG1,U,8)
84 ...S MSGTYPE=$P(DG1,U,4)
85 ...;Check Screens
86 ...Q:MSGSTAT'=1&(MSGSTAT'=$S(STATUS="A":2,STATUS="R":3,1:""))
87 ...Q:'@SCRNARR@("PROVIDERS")&'$D(@SCRNARR@("PROVIDERS",COORD))
88 ...;Resolve external values for PATIENT
89 ...S SSN=$E($$GET1^DIQ(2,PATIENT,.09,"I"),6,9)
90 ...S PATIENT=$$GET1^DIQ(2,PATIENT,.01,"E")
91 ...;Resolve external value for VENDOR
92 ...S VENDOR=$$GET1^DIQ(4,VENDOR,.01,"E")
93 ...;Resolve external value for COORD
94 ...S COORD=$$GET1^DIQ(200,COORD,.01,"E")
95 ...;Increment counter and save for later
96 ...S CNT=CNT+1
97 ...S ^TMP("DGHT",$J,CNT)=PATIENT_U_SSN_U_VENDOR_U_COORD_U_CONSULT_U_DATE_U_MSGID_U_ACKDATE_U_STATUS_U_REJECT_U_MSGTYPE
98 Q
99HEADER ;print header
100 S PAGENUM=PAGENUM+1
101 S $P(LN,"-",80)=""
102 W @IOF
103 W !,"Home Telehealth ",$S(MSGSTAT=1:"All",MSGSTAT=2:"Accepted",MSGSTAT=3:"Rejected",1:"")_" Transmissions Report ",?65,"Page: ",PAGENUM
104 W !!,"Report for ",$$FMTE^XLFDT(DGSD)," thru ",$$FMTE^XLFDT(DGED)
105 W !!,?1,"Patient",?22,"SSN",?28,"HT Vendor",?50,"Care Coordinator",?68,"Consult #"
106 W !?3,"Event/Trans Date",?28,"Message ID",?50,"ACK Date/Time",?69,"Status"
107 W !?3,"Message Type",?28,"Reject Message",?50,"Retransmitted"
108 W !?1,LN
109 Q
110 ;
111DETAIL ;Print detailed line
112 ;Input : ^TMP("DGHT",$J) full global reference
113 ; PATIENT - HTH Patient
114 ; SSN - Patient SSN's last four
115 ; VENDOR - HTH Vendor Server
116 ; COORD - Care Coordinator
117 ; CONSULT - CONSULT # file 123
118 ; DATE - Event/Transmission Date
119 ; MSGID - Message ID
120 ; ACK DATE - ACK Date and Time
121 ; STATUS - Registration Status
122 ; REJECT - Reject message
123 ; MSGTYPE - Message Type
124 ;Output : None
125 ;Set acknowledgement status
126 N RECORD,NODE,MSGID,ACKSTAT
127 S (MSGID,ACKSTAT,NODE)="",RECORD=0
128 F S RECORD=$O(^TMP("DGHT",$J,RECORD)) Q:'RECORD D Q:STOP
129 .S NODE=^TMP("DGHT",$J,RECORD)
130 .S MSGID=$P(NODE,U,7),ACKSTAT=+$$MSGSTAT^HLUTIL(MSGID)
131 .W !,?1,$E($P(NODE,U,1),1,20),?22,$P(NODE,U,2),?28,$E($P(NODE,U,3),1,20),?50,$E($P(NODE,U,4),1,16),?68,$P(NODE,U,5)
132 .W !?3,$E($$FMTE^XLFDT($P(NODE,U,6),"1"),1,18),?28,$P(NODE,U,7),?47,$E($$FMTE^XLFDT($P(NODE,U,8),"1"),1,18),?69,$S($P(NODE,U,9)="A":"Accepted",$P(NODE,U,9)="R":"Rejected",ACKSTAT=1:"Pending TR",ACKSTAT=2:"Awaiting AA",1:"Unknown")
133 .W !,?3,$S($P(NODE,U,11)="A":"Activation",$P(NODE,U,11)="I":"Inactivation",1:""),?28,$P(NODE,U,10)
134 .;if there is data in the "HTHNOACK" node resolve number of retries
135 .I $O(^DGHT(391.31,"HTHNOACK",$S(MSGID'="":MSGID,1:0),0)) D
136 ..N RECORD,TRANS,RETRANS
137 ..S (RECORD,TRANS,RETRANS)=0
138 ..S RECORD=$O(^DGHT(391.31,"HTHNOACK",MSGID,0)),TRANS=$O(^DGHT(391.31,"HTHNOACK",MSGID,RECORD,0)),RETRANS=$P($G(^DGHT(391.31,"HTHNOACK",MSGID,RECORD,TRANS)),U,1)
139 ..W ?50,RETRANS
140 .W !
141 .I $Y>(IOSL-5) D WAIT Q:STOP D HEADER
142 Q
143 ;
144TOTAL ;Report totals
145 W !!?1,"Total Number of Home Telehealth Records: ",?23,CNT
146 Q
147 ;
148WAIT ;End of page logic
149 ;Input ; None
150 ;Output ; STOP - Flag inidcating if printing should continue
151 ; 1 = Stop 0 = Continue
152 ;
153 N DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
154 ;CRT - Prompt for continue
155 I $E(IOST,1,2)="C-"&(IOSL'>24) D Q
156 .F Q:$Y>(IOSL-3) W !
157 .S DIR(0)="E"
158 .D ^DIR
159 .S STOP=$S(Y'=1:1,1:0)
160 ;Background task - check taskman
161 S STOP=$$S^%ZTLOAD()
162 I STOP D
163 .W !,"*********************************************"
164 .W !,"* PRINTING OF REPORT STOPPED AS REQUESTED *"
165 .W !,"*********************************************"
166 Q
167EXIT ;Kill temp global
168 K ^TMP("DGHT",$J)
169 Q
Note: See TracBrowser for help on using the repository browser.