- LREPIRM ;VA/DALOI/SED - EMERGING PATHOGENS SEARCH ; 7/16/96
- ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997
- ;;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
- ;
- LREPIRM ;VA/DALOI/SED - EMERGING PATHOGENS SEARCH ; 7/16/96
- +1 ;;5.2;LAB SERVICE;**1030**;NOV 01, 1997
- +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 ;
- 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 ;
