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