source: WorldVistAEHR/trunk/r/LAB_SERVICE-LR-LS/LREPIRM.m@ 1006

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

initial load of WorldVistAEHR

File size: 5.3 KB
Line 
1LREPIRM ;DALOI/SED - EMERGING PATHOGENS SEARCH ; 7/16/96
2 ;;5.2;LAB SERVICE;**175,281**;Sep 27, 1994
3 ; Reference to ^ORD(101 supported by IA #972
4 ;
5 ;Search Parameters - LREPI(#)
6 ;Search Date -Start LRRPS
7 ; Stop LRRPE
8 ;
9MAN ;USED TO RERUN THE OPTION FOR ANY PRIOR MONTHS
10 S LRRTYPE=1
11 W @IOF,?(IOM/2-15),"Laboratory Search rerun option"
12PROT ;SELECT PROTOCOL
13 K DIC,LRPROT,X,Y
14 S DIC="69.4",DIC("A")="Select Protocol: "
15 S DIC(0)="AEMNQ"
16 S DIC("W")="W ?40,$P(^(0),U,5)"
17 D ^DIC
18 G:+Y'>0 EXIT
19 S LRPROT=+Y
20OVR K DIR,DIRUT
21 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Override Any Inactive indicators: "
22 S DIR("?")="Enter (Y)es if the overriding of any Inactive indicator is desired. "
23 D ^DIR
24 G:$D(DIRUT) PROT
25 S LROVR=+Y
26CRI K LRCYCLE,LREPI S LRMSG="Search Parameters" D ALL G:$D(DIRUT) OVR
27 K DIR,DIRUT,DTOUT,DUOUT,DIROUT
28 I +LRALL D PICKALL
29 I +LRALL'>0 D
30 .W @IOF
31 .F Q:$D(DIRUT) D
32 ..S DIR(0)="PAO^69.5:EMZ",DIR("A")="Select Search Parameters: "
33 ..S DIR("?")="Select the Search Parameters. "
34 ..S DIR("S")="D CHK^LREPIRM I LROK"
35 ..D ^DIR
36 ..Q:$D(DIRUT)
37 ..S LREPI(+Y)=""
38 G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) CRI
39 I '$D(LREPI) W !,"Sorry No Search Parameters Selected" G CRI
40DATE ;Select Search Date
41 K DIR,DIRUT
42 S DIR("A")="Select Search Date: "
43 S DIR(0)="DOA^:"_DT_":E" D ^DIR
44 G:$D(DIRUT) CRI
45 K DIR,DIRUT,LRCYCLE
46 S LRTYPE=$O(LREPI(0))
47 S LRCYCLE=$P(^LAB(69.5,LRTYPE,0),U,5)
48 S X=Y I LRCYCLE="M" D
49 .D DAYS
50 .S LRRPE=$E(Y,1,5)_X,LRRPS=$E(Y,1,5)_"01"
51 I LRCYCLE="D" S (LRRPE,LRRPS)=Y
52 K X,Y,X1,LRCYCLE,LRTYPE
53 D TASK ;;*Cincinnati - Toggle Task On/Off*
54 ;D EN^LREPI ;;Cincinnati - Toggle Console Execution On/Off*
55EXIT ;
56 K D0,LRAUTO,LRBEG,LRDT,LREND,LRRNDT,LREPI,LRRPE,LRRPS,LRPREV,ZTSAVE
57 K LRRSD,LRLAG,ZTREQ,ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK,X,Y,X1,%DT
58 Q
59 ;
60TASK ;LETS TASK THIS JOB
61 Q:'$D(LREPI)
62 K ZTSAVE
63 S (ZTSAVE("LREPI("),ZTSAVE("LRRPS"),ZTSAVE("LRRPE"))=""
64 S ZTSAVE("LRRTYPE")="",ZTSAVE("LRPREV")="" S:LRRTYPE=0 ZTDTH=DT
65 S ZTIO="",ZTRTN="EN^LREPI",ZTDESC="Laboratory EPI",ZTREQ="@"
66 D ^%ZTLOAD
67 I '$D(ZTQUEUED)&($D(ZTSK)) W @IOF,!!,"The Task has been queued",!,"Task # ",$G(ZTSK) H 5
68 Q
69PICKALL ;SELECT ALL ASSOCIATED PARAMETERS
70 S Y=0 F S Y=$O(^LAB(69.5,Y)) Q:+Y'>0!(Y>99) D CHK S:LROK LREPI(Y)=""
71 Q
72CHK ;CHECK TO SEE IF ITS OK
73 I Y>99 S LROK=0 Q
74CHKL ;CHECK FOR LOCAL PATHOGENS
75 S:'$D(LRCYCLE) LRCYCLE=$P(^LAB(69.5,Y,0),U,5)
76 S LROK=1
77 S:$P(^LAB(69.5,Y,0),U,7)'=LRPROT LROK=0 Q
78 S:'LROVR&($P(^LAB(69.5,Y,0),U,2)="1") LROK=0 Q
79 S:$P(^LAB(69.5,Y,0),U,7)="" LROK=0 Q
80 S:'$D(^ORD(101,$P(^LAB(69.5,Y,0),U,7),0)) LROK=0 Q
81 S:$P(^LAB(69.5,Y,0),U,5)=LRCYCLE LROK=0 Q
82 Q
83ALL K DIR,DIRUT
84 S DIR(0)="Y",DIR("B")="YES",DIR("A")="Include All "_LRMSG
85 S DIR("?")="Enter (Y)es or return for all entries to be Selected"
86 D ^DIR
87 S LRALL=+Y
88 Q
89AUTO ; CHECKS TO SEE IF IT IS TIME TO RUN A SEARCH
90 K %DT,X,Y,LREPI,^TMP($J)
91 S D0=0
92 F S D0=$O(^LAB(69.5,D0)) Q:+D0'>0!(+D0>99) D
93 .Q:$P(^LAB(69.5,D0,0),U,2)="1"
94 .Q:$P(^LAB(69.5,D0,0),U,7)=""
95 .Q:'$D(^ORD(101,$P(^LAB(69.5,D0,0),U,7),0))
96 .S LRCYC=$P(^LAB(69.5,D0,0),U,5)
97 .Q:LRCYC=""
98 .S LRRNDT=$P(^LAB(69.5,D0,0),U,4)
99 .S LRLAG=$P(^LAB(69.5,D0,0),U,3)
100 .S:+$G(LRLAG)'>0 LRLAG="1"
101 .S X="T-"_+(LRLAG-1) D ^%DT Q:+Y'>0
102 .S LRRSD=+Y
103 .;Look at the monthly runs
104 .I LRCYC="M" D
105 ..S X=$S($E(LRRSD,4,5)="01":($E(LRRSD,1,3)-1),1:$E(LRRSD,1,3))
106 ..S X1=$S($E(LRRSD,4,5)="01":"12",1:($E(LRRSD,4,5)-1))
107 ..S:X1<10 X1="0"_X1
108 ..S X=X_X1
109 ..K X1,Y D DAYS
110 ..S LRRPS=$E(X1,1,5)_"01",LRRPE=$E(X1,1,5)_X
111 ..S:LRLAG<10 LRLAG="0"_LRLAG
112 ..S LRDT=$E(DT,1,5)_LRLAG
113 ..I LRRNDT="" S ^TMP($J,"CYC",LRCYC,LRRPS,D0)=LRRPE Q
114 ..Q:DT<LRDT
115 ..Q:DT>LRDT
116 ..S ^TMP($J,"CYC",LRCYC,LRRPS,D0)=LRRPE Q
117 .;LOOK FOR DAILY RUNS
118 .I LRCYC="D" D
119 ..S (LRRPS,LRRPE)=LRRSD
120 ..I LRRNDT="" S ^TMP($J,"CYC",LRCYC,LRRPS,D0)=LRRPE Q
121 ..;Q:LRRNDT>LRRPS
122 ..S ^TMP($J,"CYC",LRCYC,LRRPS,D0)=LRRPE Q
123 ;Lets Task the Jobs
124 K LRRPE,LRRPS,LRCYC,D0
125 F LRCYC="M","D" I $D(^TMP($J,"CYC",LRCYC)) D
126 .S LRRPS=0
127 .F S LRRPS=$O(^TMP($J,"CYC",LRCYC,LRRPS)) Q:+LRRPS'>0 D
128 ..K LREPI
129 ..S D0=0 F S D0=$O(^TMP($J,"CYC",LRCYC,LRRPS,D0)) Q:+D0'>0!(D0>99) D
130 ...S LRRPE=$P(^TMP($J,"CYC",LRCYC,LRRPS,D0),U,1),LREPI(D0)=LRRPS_U_LRRPE
131 ..S LRRTYPE=0
132 ..D TASK
133 K LREPI
134 F LRCYC="M","D" I $D(^TMP($J,"CYC",LRCYC)) D
135 .S LRRPS=0
136 .F S LRRPS=$O(^TMP($J,"CYC",LRCYC,LRRPS)) Q:+LRRPS'>0 D
137 ..K LREPI
138 ..S D0=0 F S D0=$O(^TMP($J,"CYC",LRCYC,LRRPS,D0)) Q:+D0'>0!(D0>99) D
139 ...Q:'$P(^LAB(69.5,D0,0),U,13)
140 ...S LRRPE=$P(^TMP($J,"CYC",LRCYC,LRRPS,D0),U,1),LREPI(D0)=LRRPS_U_LRRPE
141 ..S LRRTYPE=0
142 I $D(LREPI) D
143 .S LRPREV=1
144 .S D0=0 F S D0=$O(LREPI(D0)) Q:D0'>0 S LRRPS=$P(LREPI(D0),U),LRRPE=$P(LREPI(D0),U,2) D PREV,TASK
145 G EXIT
146DAYS ;GET DAYS OF THE MONTH
147 S X1=X,X=+$E(X,4,5),X=$S("^1^3^5^7^8^10^12^"[(U_X_U):31,X'=2:30,$E(X1,1,3)#4:28,1:29)
148 Q
149 ;
150PREV S LRPRECYC=$P(^LAB(69.5,D0,0),U,13),LRRPS=$P(LREPI(D0),U),LRRPE=$P(LREPI(D0),U,2) D
151 .I $P(^LAB(69.5,D0,0),U,5)="D" D
152 ..S X1=$P(LRRPS,"."),X2=LRPRECYC D C^%DTC S (LRRPS,LRRPE)=X
153 .I $P(^LAB(69.5,D0,0),U,5)="M" D
154 ..S X1=$P(LRRPS,"."),X2=$E(X1,4,5),X3=X2-LRPRECYC
155 ..I X3>0 S LRRPS=$E(X1,1,3)_$S($L(X3)=1:"0"_X3,1:X3)_"01"
156 ..I X3'>0 S X3=12+X3,LRRPS=$E(X1,1,3)_$S($L(X3)=1:"0"_X3,1:X3)_"01"
157 ..S X1=$P(LRRPE,"."),X2=$E(X1,4,5),X3=X2-LRPRECYC
158 ..I X3'>0 S X3=12+X3
159 ..S DAYS=$S("^1^3^5^7^8^10^12^"[(U_+X3_U):31,+X3'=2:30,$E(X1,1,3)#4:28,1:29)
160 ..S LRRPE=$E(X1,1,3)_$S($L(X3)=1:"0"_X3,1:X3)_DAYS
161 ..K X,X1,X2,X3,DAYS
162 Q
163 ;
Note: See TracBrowser for help on using the repository browser.