source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAHLRS1.m@ 1714

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

revised back to 6/30/08 version

File size: 7.5 KB
Line 
1RAHLRS1 ;HIRMFO/ROB/PAVEL - Resend HL7 messages for selected Timeframe ; 4/2/07 3:42pm
2 ;;5.0;Radiology/Nuclear Medicine;**80**;Mar 01, 2007;Build 19
3 ;
4 ; Utility to RESEND HL7 messages for selected Timeframe
5 ;
6 N RACNI,RADFN,RADTI,RARPT,X,RAED,RABD,RASHBD,RASHED,RASHTD,RASHTM,DIC,DA,XX,YY
7 N RALOCK,RASSS,RASSSX,RASSSL,I,X S RALOCK=0
8CHECK ;
9 D SETVARS Q:$G(RAIMGTY)=""
10 W !!,"This option re-sends HL7 messages for a date range and for designated Recipients.",!
11 W !,"It is strongly recommended you task this to run off hours.",!!
12 S:'$D(U) U="^" S:'$D(DTIME) DTIME=9999
131 W ! K %DT S %DT="AEX",%DT("A")="Beginning Date: " D ^%DT
14 G:Y<0!($D(DTOUT))!($D(DUOUT)) STOP
15 S RABD=Y
16 X ^DD("DD") S RASHBD=Y
17 S X1=RABD,X2=-1 D C^%DTC S RABD=X
18 S RABD=RABD_"."_9999
19 ;
20 W ! K %DT S %DT="AEX",%DT("A")="Ending Date: ",%DT("B")="NOW" D ^%DT
21 G:Y<0!($D(DTOUT))!($D(DUOUT)) STOP
22 S RAED=Y
23 X ^DD("DD") S RASHED=Y
24 S RAED=RAED_"."_9999
25 K XX G:'$$GETAP(.XX) STOP
26 W !!,"****Pick the application to send the RAD data to*****",!!
27 F I=1:1 Q:'$D(XX(I)) W !," #",I," ",$O(XX(I,""))
282 S DIR(0)="N"
29 W ! S DIR("?")="Please select an available application from the list"
30 D ^DIR Q:$D(DIRUT) I (X'<1),(X'<I) W "Please select an available application from the list" G 2
31 W !!,"The: ",$O(XX(+X,""))," will be the recipient"
32 W !!,"Reviewing exams for selected time period... (This may take a few minutes)... "
33 S Y=$$GETSUM(RABD,RAED)
34 I 'Y W !!,"No exams exist for selected period, change the time frame !!!" H 3 W ! G 1
35 W !!,"During this period of time ",Y," Exams were performed and app Run time= ",Y\5000," Hours."
36 S RASSS(XX(X,$O(XX(+X,""))))="" D GETSUB(.RASSS,.RASSSX,.RASSSL)
37 K ZTSAVE
38 S ZTSAVE("RASSSX(")="",ZTSAVE("RASSSL(")="",ZTSAVE("RABD")="",ZTSAVE("RAED")="",ZTSAVE("RADFN")=""
39 S ZTSAVE("RADTI")="",ZTSAVE("RACNI")="",ZTSAVE("RASHBD")="",ZTSAVE("RASHED")="",ZTIO=""
40 S ZTDESC="Rad/Nuc Med Compiling HL7 Common Order",ZTRTN="TM^RAHLRS1"
41 W ! K %DT S %DT="AEXT",%DT("A")="Scheduled time to run: ",%DT("B")="TODAY@23:59" D ^%DT
42 G:Y<0!($D(DTOUT))!($D(DUOUT)) STOP
43 S X=Y,YY=Y D H^%DTC S ZTDTH=$G(%H)_","_$G(%T)
44 S Y=YY X ^DD("DD") S RASHTM=Y
45 D ^%ZTLOAD
46 W !,"Task ",$S('$D(ZTSK):" Has Not been Tasked !!!",1:"#:"_ZTSK_" Has been Tasked")
47 D:$D(ZTSK)
48 .N X,RAMPG,XMSUB,XMY,XMTEXT
49 .S X(1)="Task #"_$G(ZTSK)_" is scheduled to run the option: "
50 .S X(2)=">>Re-send HL7 messages for a date range and for designated Recipient.<<"
51 .S X(3)=" Scheduled time to run: "_RASHTM
52 .S X(4)="Date range from: "_$G(RASHBD)_" to: "_$G(RASHED)
53 .S XMSUB="TASKMAN SCHEDULE NOTIFICATION/INFO"
54 .S RAMPG="G.RAD HL7 MESSAGES"
55 .S XMY(RAMPG)="",XMDUZ=.5
56 .S XMTEXT="X("
57 .D ^XMD
58 Q
59 ;
60TM ;Taskman Entry...
61 N RASTIME,RASUM7,RASUM7R,RASUM7E
62 S RASTIME=$H,(RASUM7,RASUM7R,RASUM7E)=0
63 F S RABD=$O(^RADPT("AR",RABD)) Q:'RABD!(RABD>RAED) D
64 .S RADFN=0 F S RADFN=$O(^RADPT("AR",RABD,RADFN)) Q:'RADFN D
65 ..S RADTI=0 F S RADTI=$O(^RADPT("AR",RABD,RADFN,RADTI)) Q:'RADTI D
66 ...S RACNI=0 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI D RESEND(RADFN,RADTI,RACNI)
67 K X S X(1)="Task #"_$G(ZTSK)_" successfully completed the option: "
68 S X(2)=">>Re-send HL7 messages for a date range and for designated Recipient.<<"
69 S X(3)="Date range from: "_$G(RASHBD)_" to: "_$G(RASHED)
70 S X(4)="# Of RAD Reports transferred: "_$G(RASUM7R)
71 S X(5)="# Of Exams transferred: "_$G(RASUM7)
72 S:$G(RASUM7E) X(6)="# Of Exams not transferred because of ""BAD DATA"": "_$G(RASUM7E)
73 S XMSUB="TASKMAN ""RESEND HL7 OPTION"" COMPLETED/INFO"
74 S RAMPG="G.RAD HL7 MESSAGES"
75 S XMY(RAMPG)="",XMDUZ=.5
76 S XMTEXT="X("
77 D ^XMD
78 G STOP
79 Q
80 ;
81RESEND(RADFN,RADTI,RACNI) ; re-send exam message(s) to HL7 subscribers
82 ; for every 10 messages sent, make sure queue is not clogged... $$HANG
83 I '(+^(RACNI,0)) S RASUM7E=RASUM7E+1 Q
84 I '$P(^(0),U,2) S RASUM7E=RASUM7E+1 Q
85 N RABD,RAED,QUIT
86 ;
87 I '$D(DT) D ^%DT S DT=Y
88 ;
89 S RAED=$$RAED(RADFN,RADTI,RACNI)
90 I '$L(RAED) S RASUM7E=RASUM7E+1 Q
91 D:RAED[",REG,"
92 .D CHSUM N RASUM7,RASUM7R,RASUM7E D REG^RAHLRPC
93 D:RAED[",CANCEL,"
94 .D CHSUM N RASUM7,RASUM7R,RASUM7E D CANCEL^RAHLRPC
95 D:RAED[",EXAM,"
96 .D CHSUM
97 .S $P(^RADPT(RADFN,"DT",RADTI,"P",RACNI,0),"^",30)="" ;Reset sent flag
98 .N RASUM7,RAEXMDUN,RASUM7R,RASUM7E D 1^RAHLRPC
99 D:RAED[",RPT,"
100 .D CHSUM N RASUM7,RANOSEND,RASUM7R,RASUM7E,RARPT D RPT^RAHLRPC
101 Q
102 ;
103RAED(RADFN,RADTI,RACNI) ; identify correct ^RAHLRPC entry point(s)
104 ;
105 N RASTAT,RAIMTYP,RAORD,RETURN,RARPT
106 S RASTAT=""
107 ;
108 S RETURN=",REG,"
109 ;
110 S RASTAT=$$GET1^DIQ(70.03,RACNI_","_RADTI_","_RADFN,3,"I")
111 S RARPT=$$GET1^DIQ(70.03,RACNI_","_RADTI_","_RADFN,17,"I")
112 ;
113 S RAIMTYP=$$GET1^DIQ(72,+RASTAT,7) Q:'$L(RAIMTYP) ""
114 S RAORD=$$GET1^DIQ(72,+RASTAT,3)
115 ;
116 S:RAORD=0 RETURN=RETURN_"CANCEL,"
117 ;
118 S:$$GET1^DIQ(72,+RASTAT,8)="YES" RETURN=RETURN_"EXAM," ; Generate Examined HL7 Message
119 ;
120 D:RETURN'[",EXAM,"
121 .; also check previous statuses for 'Generate Examined HL7 Message'
122 .F S RAORD=$O(^RA(72,"AA",RAIMTYP,RAORD),-1) Q:+RAORD<1 D Q:RETURN[",EXAM,"
123 ..S RASTAT=$O(^RA(72,"AA",RAIMTYP,RAORD,0))
124 ..S:$$GET1^DIQ(72,+RASTAT,8)="YES" RETURN=RETURN_"EXAM,"
125 ;
126 ; Check if Verified Report exists
127 I RARPT]"",$$GET1^DIQ(74,RARPT_",",5,"I")="V" S RETURN=RETURN_"RPT,",RASUM7R=RASUM7R+1
128 ;
129 Q RETURN
130 ;
131SETVARS ; Setup key Rad/Nuc Med variables
132 ;
133 I $O(RACCESS(DUZ,""))="" D SETVARS^RAPSET1(0)
134 Q:'($D(RACCESS(DUZ))\10) ; user does not have location access
135 I $G(RAIMGTY)="" D SETVARS^RAPSET1(1) K:$G(RAIMGTY)="" XQUIT
136 Q
137STOP ;
138 D ^%ZISC
139 Q
140 ;
141GETAP(XX) ;
142 ;Get list of Applications in XX
143 N XXX,X11,X1,X2,X3,Z,Z1,J
144 F X11="RA REG","RA EXAMINED","RA CANCEL","RA RPT" D
145 .S X1=$E(X11,1,$L(X11)-1)_$C($A($E(X11,$L(X11)))-1)
146 .F S X1=$O(^ORD(101,"B",X1)) Q:X1'[X11 S X2=$O(^ORD(101,"B",X1,0)) Q:'X2 D
147 ..K Z S X3=0 F S X3=$O(^ORD(101,X2,775,X3)) Q:'X3 S Z(+^(X3,0))=""
148 ..Q:'$D(Z) K Z1 S X3=0 F S X3=$O(Z(X3)) Q:'X3 S XXX(+$P($G(^ORD(101,X3,770)),U,2))=""
149 S X1=0 F J=1:1 S X1=$O(XXX(X1)) Q:'X1 S XX(J,$P(^HL(771,X1,0),U))=X1
150 Q $S($D(XXX):1,1:0)
151 ;
152GETSUB(APL,SUB,LINK) ;Get all subscribers (not associated with application)... To be excluded as receipients..
153 ; Get all logical links to be in business, so we can control flow of messages
154 ;APL(IEN) = Application 771 IENs Input
155 ;SUB(Event Driver IEN,Subscriber IEN)="" Output
156 ;LINK(IEN of logical link)
157 N XX,X11,X1,X2,X3
158 Q:'$O(APL(0))
159 F X11="RA REG","RA EXAMINED","RA CANCEL","RA RPT" D
160 .S X1=$E(X11,1,$L(X11)-1)_$C($A($E(X11,$L(X11)))-1)
161 .F S X1=$O(^ORD(101,"B",X1)) Q:X1'[X11 S X2=$O(^ORD(101,"B",X1,0)) Q:'X2 D
162 ..S X3=0 F S X3=$O(^ORD(101,X2,775,X3)) Q:'X3 S XX=+^(X3,0) D
163 ...I '$D(APL(+$P($G(^ORD(101,XX,770)),U,2))) S SUB(X2,XX)=X1 Q
164 ...S XX=+$P($G(^ORD(101,XX,770)),U,7) S:XX LINK(XX)=""
165 Q
166GETHLP(RAEID,HLP) ; Get excluded subcribers set into HLP array
167 N I,J,II S II=$O(HLP("EXCLUDE SUBSCRIBER",99999999),-1)+1
168 S I=0 F J=II:1 S I=$O(RASSSX(RAEID,I)) Q:'I S HLP("EXCLUDE SUBSCRIBER",J)=I
169 Q
170CHSUM ;CHECKSUM
171 S RASUM7=RASUM7+1 I '(RASUM7#50) F Q:'$$HANG H 15
172 Q
173HANG() ; scan all logical links to see if queue is bigger than 100
174 N I,S,L,QUIT
175 S (QUIT,L)=0
176 F S L=$O(RASSSL(L)) Q:'L S (S,I)=0 D Q:QUIT
177 .F S I=$O(^HLMA("AC","O",L,I)) Q:'I S S=S+1 I S>100 S QUIT=1 Q ;Quit if more than 100 messages waiting in outgoing queue for link...
178 Q QUIT
179GETSUM(RABD,RAED) ; Get number of exams for period called from RAHLR RAHLR1 RAHLRPT RAHLRPT1
180 N RADFN,RADTI,RACNI,RASUM7
181 S RASUM7=0
182 F S RABD=$O(^RADPT("AR",RABD)) Q:'RABD!(RABD>RAED) D
183 .S RADFN=0 F S RADFN=$O(^RADPT("AR",RABD,RADFN)) Q:'RADFN D
184 ..S RADTI=0 F S RADTI=$O(^RADPT("AR",RABD,RADFN,RADTI)) Q:'RADTI D
185 ...S RACNI=0 F S RACNI=$O(^RADPT(RADFN,"DT",RADTI,"P",RACNI)) Q:'RACNI S:^(RACNI,0) RASUM7=RASUM7+1
186 Q RASUM7
187 Q
Note: See TracBrowser for help on using the repository browser.