LRACM.m

LRACM ; IHS/DIR/FJE - MENU FOR CUMULATIVE REPORTS 2/19/91 10:11 ;

 ;;5.2;LR;**1013**;JUL 15, 2002

 ;

 ;;5.2;LAB SERVICE;;Sep 27, 1994

 Q

LRAC W ?25,"Kill now taking place!!!",$C(7) K ^LAC("LRAC"),^LAC("LGOT") S ^LAC("LRAC",0)="CUMULATIVE^64.7P" D DEL^LRACM4 Q

LRKILL W !?25,"Kill under way!!!",$C(7) K ^LAC("LRKILL") Q

LOC D A^LRACM1 D:LRNOT MSG D L,END Q

L D ASK^LRACM1,LOCA^LRWU Q:X[U  S LRNM=0,LRRE=1

 I '$D(^LRO(69,LRDT,1,"AR",LRLLOC)) W !?7,"SORRY, NO DATA FOR LOCATION ",LRLLOC G L

 I 'LRDT W !!,$C(7),"NO PREVIOUS RUN DEFINED",! Q

 K IO("Q") S %ZIS="QM" D ^%ZIS Q:POP  I $D(IO("Q")) K IO("Q") S ZTRTN="LOC1^LRACM",ZTSAVE("DT")="",ZTSAVE("LR*")="",ZTSAVE("DUZ")="",ZTSAVE("U")="" D ^%ZTLOAD D ^%ZISC K ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTSK Q

 U IO

LOC1 D LOAD S LRIDT=0,LRTRUE=1,LRDFN=0

 D LRLTR^LRAC1

 S LRRE=0 D ^%ZISC D END Q

DIC R !,"Select HOSPITAL LOCATION NAME: ",X:DTIME Q:'$T!(X[U)!($L(X)>20)!(X'?.ANP)  S LRLLOC=X,LRYDT=DT,DIC=44,DIC(0)="EMOQ" D ^DIC Q:Y<1!(X["?")  S LRLLOC=$S($L($P(^SC(+Y,0),U,2)):$P(^(0),U,2),1:$P(^(0),U,1)) K DIC,DIC(0)

 Q

EN ;

KILL W !,"I will initialize various portions of the Lab cumulative package.",!,"Continue only if you want to start over with the cumulative.",!

 R !!,"Do you want to continue? N// ",X:120 Q:X'["Y"  W !!,"O.K.",!!

 D LRAC,LRKILL R !!,"Initialize all page numbers? Y// ",X:120 D:X'["N" LPG^LRACM2 K DIC,%DT Q

LOAD ;from LRACM3

 S:$D(ZTQUEUED) ZTREQ="@"

 Q

MSG ;from LRACM1, LRACM3

 S IOP="HOME" D STA^LRACK

 W !!,$C(7),"THE CUMULATIVE APPARENTLY HAS NOT FINISHED.",!,"Do NOT try to reprint reports that have not finished printing!",!,"TO MANUALLY RUN/RESTART CUMULATIVE USE THE OPTION LRAC MANUAL."

 R !!,"Press any key to continue: ",X:DTIME K IOP Q

END ;from LRACM1, LRACM2, LRACM3, LRACSUM

 K ^TMP($J),LRCALE,LRADD,LRAMT,LRCTR,LRCTRR,LRDOC,LRDT,LRDT1,LRFALT,LRFD1,LRFDE,LRFED,LRFFLG,LRGRM,LRIF,LRIOZERO,LRKL,LRLTR,LROUT,LRIN,LRSDT,LREDT,LRI,LRX,LRF,LRL,LRDIS,LRACT,LRAG,LRAN,LRBDT,LRCL,LRCW,LRCL,LRDFN,LRD,LRDPF

 K LRIV,LRMYC,LRNOT,LRNUM,LRNX,LRNXSW,LRPAR,LRPG2,LRPPT,LRSET,LRSIC,LRSS,LRTBC,LRWRDVEW,LRXDT,LRXLR,LRYDT,LRRPTN,LRFD,LRFDT,LRFFDT,LRFMT,LRFN,LRFULL,LRHI,LRIDT,LRII,LRIIDT,LRIL,LRINN,LRJS,LRLFDT,LRLLOC,LRLNS,LRLO,LRLOHI,LRMH

 K ^TMP($J,"TM"),LRMHN,LRMU,LRMULT,LRNM,LRNOFL,LRNON,LRNP,LROFDT,LROFMT,LRPG,LRPL,LRSH,LRSHD,LRSHN,LRSPM,LRSPM1,LRSUB,LRTAB,LRTD,LRTF,LRTIM,LRTLOC,LRTM,LRTNN,LRTOPP,LRTOT,LRTS,LRTST,LRTSTS,LRTSTVAL,LRTT,LRUDT,LRVDT,LRVIDT,LRWRD

 K LRG,LRYESCOM,LRPERM,LRBOT,LRCDT,LRDP,LRVAR,LRNP,PNM,SEX,SSN,HRCN,Z Q  ;IHS/ANMC/CLS 11/1/95

LRACM     ; IHS/DIR/FJE - MENU FOR CUMULATIVE REPORTS 2/19/91 10:11 ;

 +1       ;;5.2;LR;**1013**;JUL 15, 2002

 +2       ;

 +3       ;;5.2;LAB SERVICE;;Sep 27, 1994

 +4        QUIT 

LRAC       WRITE ?25,"Kill now taking place!!!",$CHAR(7)

           KILL ^LAC("LRAC"),^LAC("LGOT")

           SET ^LAC("LRAC",0)="CUMULATIVE^64.7P"

           DO DEL^LRACM4

           QUIT 

LRKILL     WRITE !?25,"Kill under way!!!",$CHAR(7)

           KILL ^LAC("LRKILL")

           QUIT 

LOC        DO A^LRACM1

           IF LRNOT

               DO MSG

           DO L

           DO END

           QUIT 

L          DO ASK^LRACM1

           DO LOCA^LRWU

           IF X[U

               QUIT 

           SET LRNM=0

           SET LRRE=1

 +1        IF '$DATA(^LRO(69,LRDT,1,"AR",LRLLOC))

               WRITE !?7,"SORRY, NO DATA FOR LOCATION ",LRLLOC

               GOTO L

 +2        IF 'LRDT

               WRITE !!,$CHAR(7),"NO PREVIOUS RUN DEFINED",!

               QUIT 

 +3        KILL IO("Q")

           SET %ZIS="QM"

           DO ^%ZIS

           IF POP

               QUIT 

           IF $DATA(IO("Q"))

               KILL IO("Q")

               SET ZTRTN="LOC1^LRACM"

               SET ZTSAVE("DT")=""

               SET ZTSAVE("LR*")=""

               SET ZTSAVE("DUZ")=""

               SET ZTSAVE("U")=""

               DO ^%ZTLOAD

               DO ^%ZISC

               KILL ZTRTN,ZTIO,ZTDESC,ZTSAVE,ZTSK

               QUIT 

 +4        USE IO

LOC1       DO LOAD

           SET LRIDT=0

           SET LRTRUE=1

           SET LRDFN=0

 +1        DO LRLTR^LRAC1

 +2        SET LRRE=0

           DO ^%ZISC

           DO END

           QUIT 

DIC        READ !,"Select HOSPITAL LOCATION NAME: ",X:DTIME

           IF '$TEST!(X[U)!($LENGTH(X)>20)!(X'?.ANP)

               QUIT 

           SET LRLLOC=X

           SET LRYDT=DT

           SET DIC=44

           SET DIC(0)="EMOQ"

           DO ^DIC

           IF Y<1!(X["?")

               QUIT 

           SET LRLLOC=$SELECT($LENGTH($PIECE(^SC(+Y,0),U,2)):$PIECE(^(0),U,2),1:$PIECE(^(0),U,1))

           KILL DIC,DIC(0)

 +1        QUIT 

EN        ;

KILL       WRITE !,"I will initialize various portions of the Lab cumulative package.",!,"Continue only if you want to start over with the cumulative.",!

 +1        READ !!,"Do you want to continue? N// ",X:120

           IF X'["Y"

               QUIT 

           WRITE !!,"O.K.",!!

 +2        DO LRAC

           DO LRKILL

           READ !!,"Initialize all page numbers? Y// ",X:120

           IF X'["N"

               DO LPG^LRACM2

           KILL DIC,%DT

           QUIT 

LOAD      ;from LRACM3

 +1        IF $DATA(ZTQUEUED)

               SET ZTREQ="@"

 +2        QUIT 

MSG       ;from LRACM1, LRACM3

 +1        SET IOP="HOME"

           DO STA^LRACK

 +2        WRITE !!,$CHAR(7),"THE CUMULATIVE APPARENTLY HAS NOT FINISHED.",!,"Do NOT try to reprint reports that have not finished printing!",!,"TO MANUALLY RUN/RESTART CUMULATIVE USE THE OPTION LRAC MANUAL."

 +3        READ !!,"Press any key to continue: ",X:DTIME

           KILL IOP

           QUIT 

END       ;from LRACM1, LRACM2, LRACM3, LRACSUM

 +1        KILL ^TMP($JOB),LRCALE,LRADD,LRAMT,LRCTR,LRCTRR,LRDOC,LRDT,LRDT1,LRFALT,LRFD1,LRFDE,LRFED,LRFFLG,LRGRM,LRIF,LRIOZERO,LRKL,LRLTR,LROUT,LRIN,LRSDT,LREDT,LRI,LRX,LRF,LRL,LRDIS,LRACT,LRAG,LRAN,LRBDT,LRCL,LRCW,LRCL,LRDFN,LRD,LRDPF

 +2        KILL LRIV,LRMYC,LRNOT,LRNUM,LRNX,LRNXSW,LRPAR,LRPG2,LRPPT,LRSET,LRSIC,LRSS,LRTBC,LRWRDVEW,LRXDT,LRXLR,LRYDT,LRRPTN,LRFD,LRFDT,LRFFDT,LRFMT,LRFN,LRFULL,LRHI,LRIDT,LRII,LRIIDT,LRIL,LRINN,LRJS,LRLFDT,LRLLOC,LRLNS,LRLO,LRLOHI,LRMH

 +3        KILL ^TMP($JOB,"TM"),LRMHN,LRMU,LRMULT,LRNM,LRNOFL,LRNON,LRNP,LROFDT,LROFMT,LRPG,LRPL,LRSH,LRSHD,LRSHN,LRSPM,LRSPM1,LRSUB,LRTAB,LRTD,LRTF,LRTIM,LRTLOC,LRTM,LRTNN,LRTOPP,LRTOT,LRTS,LRTST,LRTSTS,LRTSTVAL,LRTT,LRUDT,LRVDT,LRVIDT,LRWRD

 +4       ;IHS/ANMC/CLS 11/1/95

           KILL LRG,LRYESCOM,LRPERM,LRBOT,LRCDT,LRDP,LRVAR,LRNP,PNM,SEX,SSN,HRCN,Z

           QUIT