Routine: LRACM3

LRACM3 ; IHS/DIR/AAB - REPRINT/INITIALIZE PATIENT CUM REPORT 6/12/89 16:21 ;  [ 07/22/2002  12:30 PM ]

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

 ;;5.2;LAB SERVICE;**174,201**;Sep 27, 1994

EN02 ;

PAT D A^LRACM1 I LRNOT D MSG^LRACM

 D ASK^LRACM1 S LRRE=1 D LOOP,END^LRACM Q

LOOP K DIC D ^LRDPA Q:LRDFN<1  S LRNM=PNM,LRPAT=1 I '$D(^LAC(LRXLR,LRDFN)) W !!,$C(7),"NO DATA IN CUMULATIVE FILE FOR THIS PATIENT!!!"

 D LOC^LRWU

 Q:LREND

 R !!,"Select (1) Re-initialize/Print patient's entire cumulative",!,"       (2) Reprint patient's previous cumulative. 2// ",LRTI:DTIME Q:'$T

 S:LRTI="" LRTI=2 Q:"12"'[LRTI  I LRTI["1" D TIRE Q:Y<0

 K IO("Q") S %ZIS="QM" D ^%ZIS Q:POP

 I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^LRACM3",ZTSAVE("D*")="",ZTSAVE("LR*")="",ZTSAVE("S*")="",ZTSAVE("U")="" D ^%ZTLOAD,^%ZISC K ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE Q

 U IO

DQ D LOAD^LRACM,PT^LRX S LRIDT=0

 I LRTI["1" D A,PAT^LRAC1

 D:LRTI'["1" LRCALE^LRAC2,ENT^LRAC3,MICRO^LRAC1

 W @IOF D ^%ZISC K LRPAT,LREN,LRRE,LRAC D END^LRACM S ZTREQ="@" Q

TIRE W !!?10,$C(7),"** THIS PRINT-OUT MUST BE CHARTED!!! **",! S J=0

 S I=0 F  S I=$O(^LRO(68,"AC",LRDFN,I)) Q:I<1  S J=I

 I J>0 S J=9999999-J W:J>1 !,"STARTING DATE SHOULD AT LEAST GO BACK TO ",$$Y2K^LRX($P(J,".")),".",!,"There is data in the cross-reference back to this date that should be ",!,"on this patient's cumulative.",!

 S %DT="AEQ",%DT("A")="ENTER STARTING DATE FOR REINITIALIZATION: " D ^%DT K %DT Q:Y<0  S LRXDT=9999999-Y

A ;

 S LRRE=0 K ^LR(LRDFN,"PG"),^LAC(LRXLR,LRDFN),^LAC("LGOT",LRDFN),^LRO(68,"AC",LRDFN),^LRO(68,"MI",LRDFN)

LRIDT S LRIDT=0 F  S LRIDT=$O(^LR(LRDFN,"CH",LRIDT)) Q:LRIDT<1!(LRIDT>LRXDT)  S $P(^(LRIDT,0),U,9)="" D LRSB

 Q:'$D(^LR(LRDFN,"MI"))  S LRIDT=0 F  S LRIDT=$O(^LR(LRDFN,"MI",LRIDT)) Q:LRIDT<1!(LRIDT>LRXDT)  F LRSB=1,5,8,11,16 I $D(^LR(LRDFN,"MI",LRIDT,LRSB)),'$D(^LRO(68,"MI",LRDFN,LRIDT,LRSB)) S ^(LRSB)="" W ":"

LRSB S LRSB=0 F  S LRSB=$O(^LR(LRDFN,"CH",LRIDT,LRSB)) Q:LRSB<1  I '$D(^LRO(68,"AC",LRDFN,LRIDT,LRSB)) S ^(LRSB)="" W "."

LRACM3    ; IHS/DIR/AAB - REPRINT/INITIALIZE PATIENT CUM REPORT 6/12/89 16:21 ;  [ 07/22/2002  12:30 PM ]

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

 +2       ;

 +3       ;;5.2;LAB SERVICE;**174,201**;Sep 27, 1994

EN02      ;

PAT        DO A^LRACM1

           IF LRNOT

               DO MSG^LRACM

 +1        DO ASK^LRACM1

           SET LRRE=1

           DO LOOP

           DO END^LRACM

           QUIT

LOOP       KILL DIC

           DO ^LRDPA

           IF LRDFN<1

               QUIT

           SET LRNM=PNM

           SET LRPAT=1

           IF '$DATA(^LAC(LRXLR,LRDFN))

               WRITE !!,$CHAR(7),"NO DATA IN CUMULATIVE FILE FOR THIS PATIENT!!!"

 +1        DO LOC^LRWU

 +2        IF LREND

               QUIT

 +3        READ !!,"Select (1) Re-initialize/Print patient's entire cumulative",!,"       (2) Reprint patient's previous cumulative. 2// ",LRTI:DTIME

           IF '$TEST

               QUIT

 +4        IF LRTI=""

               SET LRTI=2

           IF "12"'[LRTI

               QUIT

           IF LRTI["1"

               DO TIRE

               IF Y<0

                   QUIT

 +5        KILL IO("Q")

           SET %ZIS="QM"

           DO ^%ZIS

           IF POP

               QUIT

 +6        IF $DATA(IO("Q"))

               KILL IO("Q")

               SET ZTRTN="DQ^LRACM3"

               SET ZTSAVE("D*")=""

               SET ZTSAVE("LR*")=""

               SET ZTSAVE("S*")=""

               SET ZTSAVE("U")=""

               DO ^%ZTLOAD

               DO ^%ZISC

               KILL ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE

               QUIT

 +7        USE IO

DQ         DO LOAD^LRACM

           DO PT^LRX

           SET LRIDT=0

 +1        IF LRTI["1"

               DO A

               DO PAT^LRAC1

 +2        IF LRTI'["1"

               DO LRCALE^LRAC2

               DO ENT^LRAC3

               DO MICRO^LRAC1

 +3        WRITE @IOF

           DO ^%ZISC

           KILL LRPAT,LREN,LRRE,LRAC

           DO END^LRACM

           SET ZTREQ="@"

           QUIT

TIRE       WRITE !!?10,$CHAR(7),"** THIS PRINT-OUT MUST BE CHARTED!!! **",!

           SET J=0

 +1        SET I=0

FOR

               SET I=$ORDER(^LRO(68,"AC",LRDFN,I))

               IF I<1

                   QUIT

               SET J=I

 +2        IF J>0

               SET J=9999999-J

               IF J>1

                   WRITE !,"STARTING DATE SHOULD AT LEAST GO BACK TO ",$$Y2K^LRX($PIECE(J,".")),".",!,"There is data in the cross-reference back to this date that should be ",!,"on this patient's cumulative.",!

 +3        SET %DT="AEQ"

           SET %DT("A")="ENTER STARTING DATE FOR REINITIALIZATION: "

           DO ^%DT

           KILL %DT

           IF Y<0

               QUIT

           SET LRXDT=9999999-Y

 +4        QUIT

A         ;

 +1        SET LRRE=0

           KILL ^LR(LRDFN,"PG"),^LAC(LRXLR,LRDFN),^LAC("LGOT",LRDFN),^LRO(68,"AC",LRDFN),^LRO(68,"MI",LRDFN)

LRIDT      SET LRIDT=0

FOR

               SET LRIDT=$ORDER(^LR(LRDFN,"CH",LRIDT))

               IF LRIDT<1!(LRIDT>LRXDT)

                   QUIT

               SET $PIECE(^(LRIDT,0),U,9)=""

               DO LRSB

 +1        IF '$DATA(^LR(LRDFN,"MI"))

               QUIT

           SET LRIDT=0

FOR

               SET LRIDT=$ORDER(^LR(LRDFN,"MI",LRIDT))

               IF LRIDT<1!(LRIDT>LRXDT)

                   QUIT

               FOR LRSB=1,5,8,11,16

                   IF $DATA(^LR(LRDFN,"MI",LRIDT,LRSB))

                       IF '$DATA(^LRO(68,"MI",LRDFN,LRIDT,LRSB))

                           SET ^(LRSB)=""

                           WRITE ":"

 +2        QUIT

LRSB       SET LRSB=0

FOR

               SET LRSB=$ORDER(^LR(LRDFN,"CH",LRIDT,LRSB))

               IF LRSB<1

                   QUIT

               IF '$DATA(^LRO(68,"AC",LRDFN,LRIDT,LRSB))

                   SET ^(LRSB)=""

                   WRITE "."

 +1        QUIT

LRACM3.m