LREPIRM ;DALOI/SED - EMERGING PATHOGENS SEARCH ; 7/16/96
;;5.2;LAB SERVICE;**175,281**;Sep 27, 1994
; Reference to ^ORD(101 supported by IA #972
;
;Search Parameters - LREPI(#)
;Search Date -Start LRRPS
; Stop LRRPE
;
MAN ;USED TO RERUN THE OPTION FOR ANY PRIOR MONTHS
S LRRTYPE=1
W @IOF,?(IOM/2-15),"Laboratory Search rerun option"
PROT ;SELECT PROTOCOL
K DIC,LRPROT,X,Y
S DIC="69.4",DIC("A")="Select Protocol: "
S DIC(0)="AEMNQ"
S DIC("W")="W ?40,$P(^(0),U,5)"
D ^DIC
G:+Y'>0 EXIT
S LRPROT=+Y
OVR K DIR,DIRUT
S DIR(0)="Y",DIR("B")="NO",DIR("A")="Override Any Inactive indicators: "
S DIR("?")="Enter (Y)es if the overriding of any Inactive indicator is desired. "
D ^DIR
G:$D(DIRUT) PROT
S LROVR=+Y
CRI K LRCYCLE,LREPI S LRMSG="Search Parameters" D ALL G:$D(DIRUT) OVR
K DIR,DIRUT,DTOUT,DUOUT,DIROUT
I +LRALL D PICKALL
I +LRALL'>0 D
.W @IOF
.F Q:$D(DIRUT) D
..S DIR(0)="PAO^69.5:EMZ",DIR("A")="Select Search Parameters: "
..S DIR("?")="Select the Search Parameters. "
..S DIR("S")="D CHK^LREPIRM I LROK"
..D ^DIR
..Q:$D(DIRUT)
..S LREPI(+Y)=""
G:$D(DTOUT)!$D(DUOUT)!$D(DIROUT) CRI
I '$D(LREPI) W !,"Sorry No Search Parameters Selected" G CRI
DATE ;Select Search Date
K DIR,DIRUT
S DIR("A")="Select Search Date: "
S DIR(0)="DOA^:"_DT_":E" D ^DIR
G:$D(DIRUT) CRI
K DIR,DIRUT,LRCYCLE
S LRTYPE=$O(LREPI(0))
S LRCYCLE=$P(^LAB(69.5,LRTYPE,0),U,5)
S X=Y I LRCYCLE="M" D
.D DAYS
.S LRRPE=$E(Y,1,5)_X,LRRPS=$E(Y,1,5)_"01"
I LRCYCLE="D" S (LRRPE,LRRPS)=Y
K X,Y,X1,LRCYCLE,LRTYPE
D TASK ;;*Cincinnati - Toggle Task On/Off*
;D EN^LREPI ;;Cincinnati - Toggle Console Execution On/Off*
EXIT ;
K D0,LRAUTO,LRBEG,LRDT,LREND,LRRNDT,LREPI,LRRPE,LRRPS,LRPREV,ZTSAVE
K LRRSD,LRLAG,ZTREQ,ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK,X,Y,X1,%DT
Q
;
TASK ;LETS TASK THIS JOB
Q:'$D(LREPI)
K ZTSAVE
S (ZTSAVE("LREPI("),ZTSAVE("LRRPS"),ZTSAVE("LRRPE"))=""
S ZTSAVE("LRRTYPE")="",ZTSAVE("LRPREV")="" S:LRRTYPE=0 ZTDTH=DT
S ZTIO="",ZTRTN="EN^LREPI",ZTDESC="Laboratory EPI",ZTREQ="@"
D ^%ZTLOAD
I '$D(ZTQUEUED)&($D(ZTSK)) W @IOF,!!,"The Task has been queued",!,"Task # ",$G(ZTSK) H 5
Q
PICKALL ;SELECT ALL ASSOCIATED PARAMETERS
S Y=0 F S Y=$O(^LAB(69.5,Y)) Q:+Y'>0!(Y>99) D CHK S:LROK LREPI(Y)=""
Q
CHK ;CHECK TO SEE IF ITS OK
I Y>99 S LROK=0 Q
CHKL ;CHECK FOR LOCAL PATHOGENS
S:'$D(LRCYCLE) LRCYCLE=$P(^LAB(69.5,Y,0),U,5)
S LROK=1
S:$P(^LAB(69.5,Y,0),U,7)'=LRPROT LROK=0 Q
S:'LROVR&($P(^LAB(69.5,Y,0),U,2)="1") LROK=0 Q
S:$P(^LAB(69.5,Y,0),U,7)="" LROK=0 Q
S:'$D(^ORD(101,$P(^LAB(69.5,Y,0),U,7),0)) LROK=0 Q
S:$P(^LAB(69.5,Y,0),U,5)=LRCYCLE LROK=0 Q
Q
ALL K DIR,DIRUT
S DIR(0)="Y",DIR("B")="YES",DIR("A")="Include All "_LRMSG
S DIR("?")="Enter (Y)es or return for all entries to be Selected"
D ^DIR
S LRALL=+Y
Q
AUTO ; CHECKS TO SEE IF IT IS TIME TO RUN A SEARCH
K %DT,X,Y,LREPI,^TMP($J)
S D0=0
F S D0=$O(^LAB(69.5,D0)) Q:+D0'>0!(+D0>99) D
.Q:$P(^LAB(69.5,D0,0),U,2)="1"
.Q:$P(^LAB(69.5,D0,0),U,7)=""
.Q:'$D(^ORD(101,$P(^LAB(69.5,D0,0),U,7),0))
.S LRCYC=$P(^LAB(69.5,D0,0),U,5)
.Q:LRCYC=""
.S LRRNDT=$P(^LAB(69.5,D0,0),U,4)
.S LRLAG=$P(^LAB(69.5,D0,0),U,3)
.S:+$G(LRLAG)'>0 LRLAG="1"
.S X="T-"_+(LRLAG-1) D ^%DT Q:+Y'>0
.S LRRSD=+Y
.;Look at the monthly runs
.I LRCYC="M" D
..S X=$S($E(LRRSD,4,5)="01":($E(LRRSD,1,3)-1),1:$E(LRRSD,1,3))
..S X1=$S($E(LRRSD,4,5)="01":"12",1:($E(LRRSD,4,5)-1))
..S:X1<10 X1="0"_X1
..S X=X_X1
..K X1,Y D DAYS
..S LRRPS=$E(X1,1,5)_"01",LRRPE=$E(X1,1,5)_X
..S:LRLAG<10 LRLAG="0"_LRLAG
..S LRDT=$E(DT,1,5)_LRLAG
..I LRRNDT="" S ^TMP($J,"CYC",LRCYC,LRRPS,D0)=LRRPE Q
..Q:DT<LRDT
..Q:DT>LRDT
..S ^TMP($J,"CYC",LRCYC,LRRPS,D0)=LRRPE Q
.;LOOK FOR DAILY RUNS
.I LRCYC="D" D
..S (LRRPS,LRRPE)=LRRSD
..I LRRNDT="" S ^TMP($J,"CYC",LRCYC,LRRPS,D0)=LRRPE Q
..;Q:LRRNDT>LRRPS
..S ^TMP($J,"CYC",LRCYC,LRRPS,D0)=LRRPE Q
;Lets Task the Jobs
K LRRPE,LRRPS,LRCYC,D0
F LRCYC="M","D" I $D(^TMP($J,"CYC",LRCYC)) D
.S LRRPS=0
.F S LRRPS=$O(^TMP($J,"CYC",LRCYC,LRRPS)) Q:+LRRPS'>0 D
..K LREPI
..S D0=0 F S D0=$O(^TMP($J,"CYC",LRCYC,LRRPS,D0)) Q:+D0'>0!(D0>99) D
...S LRRPE=$P(^TMP($J,"CYC",LRCYC,LRRPS,D0),U,1),LREPI(D0)=LRRPS_U_LRRPE
..S LRRTYPE=0
..D TASK
K LREPI
F LRCYC="M","D" I $D(^TMP($J,"CYC",LRCYC)) D
.S LRRPS=0
.F S LRRPS=$O(^TMP($J,"CYC",LRCYC,LRRPS)) Q:+LRRPS'>0 D
..K LREPI
..S D0=0 F S D0=$O(^TMP($J,"CYC",LRCYC,LRRPS,D0)) Q:+D0'>0!(D0>99) D
...Q:'$P(^LAB(69.5,D0,0),U,13)
...S LRRPE=$P(^TMP($J,"CYC",LRCYC,LRRPS,D0),U,1),LREPI(D0)=LRRPS_U_LRRPE
..S LRRTYPE=0
I $D(LREPI) D
.S LRPREV=1
.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
G EXIT
DAYS ;GET DAYS OF THE MONTH
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)
Q
;
PREV S LRPRECYC=$P(^LAB(69.5,D0,0),U,13),LRRPS=$P(LREPI(D0),U),LRRPE=$P(LREPI(D0),U,2) D
.I $P(^LAB(69.5,D0,0),U,5)="D" D
..S X1=$P(LRRPS,"."),X2=LRPRECYC D C^%DTC S (LRRPS,LRRPE)=X
.I $P(^LAB(69.5,D0,0),U,5)="M" D
..S X1=$P(LRRPS,"."),X2=$E(X1,4,5),X3=X2-LRPRECYC
..I X3>0 S LRRPS=$E(X1,1,3)_$S($L(X3)=1:"0"_X3,1:X3)_"01"
..I X3'>0 S X3=12+X3,LRRPS=$E(X1,1,3)_$S($L(X3)=1:"0"_X3,1:X3)_"01"
..S X1=$P(LRRPE,"."),X2=$E(X1,4,5),X3=X2-LRPRECYC
..I X3'>0 S X3=12+X3
..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)
..S LRRPE=$E(X1,1,3)_$S($L(X3)=1:"0"_X3,1:X3)_DAYS
..K X,X1,X2,X3,DAYS
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLREPIRM 5545 printed Oct 16, 2024@18:15:07 Page 2
LREPIRM ;DALOI/SED - EMERGING PATHOGENS SEARCH ; 7/16/96
+1 ;;5.2;LAB SERVICE;**175,281**;Sep 27, 1994
+2 ; Reference to ^ORD(101 supported by IA #972
+3 ;
+4 ;Search Parameters - LREPI(#)
+5 ;Search Date -Start LRRPS
+6 ; Stop LRRPE
+7 ;
MAN ;USED TO RERUN THE OPTION FOR ANY PRIOR MONTHS
+1 SET LRRTYPE=1
+2 WRITE @IOF,?(IOM/2-15),"Laboratory Search rerun option"
PROT ;SELECT PROTOCOL
+1 KILL DIC,LRPROT,X,Y
+2 SET DIC="69.4"
SET DIC("A")="Select Protocol: "
+3 SET DIC(0)="AEMNQ"
+4 SET DIC("W")="W ?40,$P(^(0),U,5)"
+5 DO ^DIC
+6 if +Y'>0
GOTO EXIT
+7 SET LRPROT=+Y
OVR KILL DIR,DIRUT
+1 SET DIR(0)="Y"
SET DIR("B")="NO"
SET DIR("A")="Override Any Inactive indicators: "
+2 SET DIR("?")="Enter (Y)es if the overriding of any Inactive indicator is desired. "
+3 DO ^DIR
+4 if $DATA(DIRUT)
GOTO PROT
+5 SET LROVR=+Y
CRI KILL LRCYCLE,LREPI
SET LRMSG="Search Parameters"
DO ALL
if $DATA(DIRUT)
GOTO OVR
+1 KILL DIR,DIRUT,DTOUT,DUOUT,DIROUT
+2 IF +LRALL
DO PICKALL
+3 IF +LRALL'>0
Begin DoDot:1
+4 WRITE @IOF
+5 FOR
if $DATA(DIRUT)
QUIT
Begin DoDot:2
+6 SET DIR(0)="PAO^69.5:EMZ"
SET DIR("A")="Select Search Parameters: "
+7 SET DIR("?")="Select the Search Parameters. "
+8 SET DIR("S")="D CHK^LREPIRM I LROK"
+9 DO ^DIR
+10 if $DATA(DIRUT)
QUIT
+11 SET LREPI(+Y)=""
End DoDot:2
End DoDot:1
+12 if $DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIROUT)
GOTO CRI
+13 IF '$DATA(LREPI)
WRITE !,"Sorry No Search Parameters Selected"
GOTO CRI
DATE ;Select Search Date
+1 KILL DIR,DIRUT
+2 SET DIR("A")="Select Search Date: "
+3 SET DIR(0)="DOA^:"_DT_":E"
DO ^DIR
+4 if $DATA(DIRUT)
GOTO CRI
+5 KILL DIR,DIRUT,LRCYCLE
+6 SET LRTYPE=$ORDER(LREPI(0))
+7 SET LRCYCLE=$PIECE(^LAB(69.5,LRTYPE,0),U,5)
+8 SET X=Y
IF LRCYCLE="M"
Begin DoDot:1
+9 DO DAYS
+10 SET LRRPE=$EXTRACT(Y,1,5)_X
SET LRRPS=$EXTRACT(Y,1,5)_"01"
End DoDot:1
+11 IF LRCYCLE="D"
SET (LRRPE,LRRPS)=Y
+12 KILL X,Y,X1,LRCYCLE,LRTYPE
+13 ;;*Cincinnati - Toggle Task On/Off*
DO TASK
+14 ;D EN^LREPI ;;Cincinnati - Toggle Console Execution On/Off*
EXIT ;
+1 KILL D0,LRAUTO,LRBEG,LRDT,LREND,LRRNDT,LREPI,LRRPE,LRRPS,LRPREV,ZTSAVE
+2 KILL LRRSD,LRLAG,ZTREQ,ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK,X,Y,X1,%DT
+3 QUIT
+4 ;
TASK ;LETS TASK THIS JOB
+1 if '$DATA(LREPI)
QUIT
+2 KILL ZTSAVE
+3 SET (ZTSAVE("LREPI("),ZTSAVE("LRRPS"),ZTSAVE("LRRPE"))=""
+4 SET ZTSAVE("LRRTYPE")=""
SET ZTSAVE("LRPREV")=""
if LRRTYPE=0
SET ZTDTH=DT
+5 SET ZTIO=""
SET ZTRTN="EN^LREPI"
SET ZTDESC="Laboratory EPI"
SET ZTREQ="@"
+6 DO ^%ZTLOAD
+7 IF '$DATA(ZTQUEUED)&($DATA(ZTSK))
WRITE @IOF,!!,"The Task has been queued",!,"Task # ",$GET(ZTSK)
HANG 5
+8 QUIT
PICKALL ;SELECT ALL ASSOCIATED PARAMETERS
+1 SET Y=0
FOR
SET Y=$ORDER(^LAB(69.5,Y))
if +Y'>0!(Y>99)
QUIT
DO CHK
if LROK
SET LREPI(Y)=""
+2 QUIT
CHK ;CHECK TO SEE IF ITS OK
+1 IF Y>99
SET LROK=0
QUIT
CHKL ;CHECK FOR LOCAL PATHOGENS
+1 if '$DATA(LRCYCLE)
SET LRCYCLE=$PIECE(^LAB(69.5,Y,0),U,5)
+2 SET LROK=1
+3 if $PIECE(^LAB(69.5,Y,0),U,7)'=LRPROT
SET LROK=0
QUIT
+4 if 'LROVR&($PIECE(^LAB(69.5,Y,0),U,2)="1")
SET LROK=0
QUIT
+5 if $PIECE(^LAB(69.5,Y,0),U,7)=""
SET LROK=0
QUIT
+6 if '$DATA(^ORD(101,$PIECE(^LAB(69.5,Y,0),U,7),0))
SET LROK=0
QUIT
+7 if $PIECE(^LAB(69.5,Y,0),U,5)=LRCYCLE
SET LROK=0
QUIT
+8 QUIT
ALL KILL DIR,DIRUT
+1 SET DIR(0)="Y"
SET DIR("B")="YES"
SET DIR("A")="Include All "_LRMSG
+2 SET DIR("?")="Enter (Y)es or return for all entries to be Selected"
+3 DO ^DIR
+4 SET LRALL=+Y
+5 QUIT
AUTO ; CHECKS TO SEE IF IT IS TIME TO RUN A SEARCH
+1 KILL %DT,X,Y,LREPI,^TMP($JOB)
+2 SET D0=0
+3 FOR
SET D0=$ORDER(^LAB(69.5,D0))
if +D0'>0!(+D0>99)
QUIT
Begin DoDot:1
+4 if $PIECE(^LAB(69.5,D0,0),U,2)="1"
QUIT
+5 if $PIECE(^LAB(69.5,D0,0),U,7)=""
QUIT
+6 if '$DATA(^ORD(101,$PIECE(^LAB(69.5,D0,0),U,7),0))
QUIT
+7 SET LRCYC=$PIECE(^LAB(69.5,D0,0),U,5)
+8 if LRCYC=""
QUIT
+9 SET LRRNDT=$PIECE(^LAB(69.5,D0,0),U,4)
+10 SET LRLAG=$PIECE(^LAB(69.5,D0,0),U,3)
+11 if +$GET(LRLAG)'>0
SET LRLAG="1"
+12 SET X="T-"_+(LRLAG-1)
DO ^%DT
if +Y'>0
QUIT
+13 SET LRRSD=+Y
+14 ;Look at the monthly runs
+15 IF LRCYC="M"
Begin DoDot:2
+16 SET X=$SELECT($EXTRACT(LRRSD,4,5)="01":($EXTRACT(LRRSD,1,3)-1),1:$EXTRACT(LRRSD,1,3))
+17 SET X1=$SELECT($EXTRACT(LRRSD,4,5)="01":"12",1:($EXTRACT(LRRSD,4,5)-1))
+18 if X1<10
SET X1="0"_X1
+19 SET X=X_X1
+20 KILL X1,Y
DO DAYS
+21 SET LRRPS=$EXTRACT(X1,1,5)_"01"
SET LRRPE=$EXTRACT(X1,1,5)_X
+22 if LRLAG<10
SET LRLAG="0"_LRLAG
+23 SET LRDT=$EXTRACT(DT,1,5)_LRLAG
+24 IF LRRNDT=""
SET ^TMP($JOB,"CYC",LRCYC,LRRPS,D0)=LRRPE
QUIT
+25 if DT<LRDT
QUIT
+26 if DT>LRDT
QUIT
+27 SET ^TMP($JOB,"CYC",LRCYC,LRRPS,D0)=LRRPE
QUIT
End DoDot:2
+28 ;LOOK FOR DAILY RUNS
+29 IF LRCYC="D"
Begin DoDot:2
+30 SET (LRRPS,LRRPE)=LRRSD
+31 IF LRRNDT=""
SET ^TMP($JOB,"CYC",LRCYC,LRRPS,D0)=LRRPE
QUIT
+32 ;Q:LRRNDT>LRRPS
+33 SET ^TMP($JOB,"CYC",LRCYC,LRRPS,D0)=LRRPE
QUIT
End DoDot:2
End DoDot:1
+34 ;Lets Task the Jobs
+35 KILL LRRPE,LRRPS,LRCYC,D0
+36 FOR LRCYC="M","D"
IF $DATA(^TMP($JOB,"CYC",LRCYC))
Begin DoDot:1
+37 SET LRRPS=0
+38 FOR
SET LRRPS=$ORDER(^TMP($JOB,"CYC",LRCYC,LRRPS))
if +LRRPS'>0
QUIT
Begin DoDot:2
+39 KILL LREPI
+40 SET D0=0
FOR
SET D0=$ORDER(^TMP($JOB,"CYC",LRCYC,LRRPS,D0))
if +D0'>0!(D0>99)
QUIT
Begin DoDot:3
+41 SET LRRPE=$PIECE(^TMP($JOB,"CYC",LRCYC,LRRPS,D0),U,1)
SET LREPI(D0)=LRRPS_U_LRRPE
End DoDot:3
+42 SET LRRTYPE=0
+43 DO TASK
End DoDot:2
End DoDot:1
+44 KILL LREPI
+45 FOR LRCYC="M","D"
IF $DATA(^TMP($JOB,"CYC",LRCYC))
Begin DoDot:1
+46 SET LRRPS=0
+47 FOR
SET LRRPS=$ORDER(^TMP($JOB,"CYC",LRCYC,LRRPS))
if +LRRPS'>0
QUIT
Begin DoDot:2
+48 KILL LREPI
+49 SET D0=0
FOR
SET D0=$ORDER(^TMP($JOB,"CYC",LRCYC,LRRPS,D0))
if +D0'>0!(D0>99)
QUIT
Begin DoDot:3
+50 if '$PIECE(^LAB(69.5,D0,0),U,13)
QUIT
+51 SET LRRPE=$PIECE(^TMP($JOB,"CYC",LRCYC,LRRPS,D0),U,1)
SET LREPI(D0)=LRRPS_U_LRRPE
End DoDot:3
+52 SET LRRTYPE=0
End DoDot:2
End DoDot:1
+53 IF $DATA(LREPI)
Begin DoDot:1
+54 SET LRPREV=1
+55 SET D0=0
FOR
SET D0=$ORDER(LREPI(D0))
if D0'>0
QUIT
SET LRRPS=$PIECE(LREPI(D0),U)
SET LRRPE=$PIECE(LREPI(D0),U,2)
DO PREV
DO TASK
End DoDot:1
+56 GOTO EXIT
DAYS ;GET DAYS OF THE MONTH
+1 SET X1=X
SET X=+$EXTRACT(X,4,5)
SET X=$SELECT("^1^3^5^7^8^10^12^"[(U_X_U):31,X'=2:30,$EXTRACT(X1,1,3)#4:28,1:29)
+2 QUIT
+3 ;
PREV SET LRPRECYC=$PIECE(^LAB(69.5,D0,0),U,13)
SET LRRPS=$PIECE(LREPI(D0),U)
SET LRRPE=$PIECE(LREPI(D0),U,2)
Begin DoDot:1
+1 IF $PIECE(^LAB(69.5,D0,0),U,5)="D"
Begin DoDot:2
+2 SET X1=$PIECE(LRRPS,".")
SET X2=LRPRECYC
DO C^%DTC
SET (LRRPS,LRRPE)=X
End DoDot:2
+3 IF $PIECE(^LAB(69.5,D0,0),U,5)="M"
Begin DoDot:2
+4 SET X1=$PIECE(LRRPS,".")
SET X2=$EXTRACT(X1,4,5)
SET X3=X2-LRPRECYC
+5 IF X3>0
SET LRRPS=$EXTRACT(X1,1,3)_$SELECT($LENGTH(X3)=1:"0"_X3,1:X3)_"01"
+6 IF X3'>0
SET X3=12+X3
SET LRRPS=$EXTRACT(X1,1,3)_$SELECT($LENGTH(X3)=1:"0"_X3,1:X3)_"01"
+7 SET X1=$PIECE(LRRPE,".")
SET X2=$EXTRACT(X1,4,5)
SET X3=X2-LRPRECYC
+8 IF X3'>0
SET X3=12+X3
+9 SET DAYS=$SELECT("^1^3^5^7^8^10^12^"[(U_+X3_U):31,+X3'=2:30,$EXTRACT(X1,1,3)#4:28,1:29)
+10 SET LRRPE=$EXTRACT(X1,1,3)_$SELECT($LENGTH(X3)=1:"0"_X3,1:X3)_DAYS
+11 KILL X,X1,X2,X3,DAYS
End DoDot:2
End DoDot:1
+12 QUIT
+13 ;
