LRACPG.m

LRACPG ; IHS/DIR/FJE - REMOVE LR(LRDFN,"PG") TO INITIALIZE PAT CUM 19 JUN 84 12:38PM ;

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

 ;

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

ANS ;

 W !,"Are you certain you wish to re-initial",!?10," every patient's cumulative pages  "

 S %=2 D YN^DICN G:%=1 GO

 W !!,"Process Aborted ",!!,$C(7)

 Q

GO W !?20,"This may take a while.  PG XREF INITIALIZATION",! S LRDFN=0

DFN W "." S LRDFN=$O(^LR(LRDFN)) Q:LRDFN<1  I $D(^LR(LRDFN,"PG")) W LRDFN," " K ^LR(LRDFN,"PG")

 G DFN

LRACPG    ; IHS/DIR/FJE - REMOVE LR(LRDFN,"PG") TO INITIALIZE PAT CUM 19 JUN 84 12:38PM ;

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

 +2       ;

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

ANS       ;

 +1        WRITE !,"Are you certain you wish to re-initial",!?10," every patient's cumulative pages  "

 +2        SET %=2

           DO YN^DICN

           IF %=1

               GOTO GO

 +3        WRITE !!,"Process Aborted ",!!,$CHAR(7)

 +4        QUIT 

GO         WRITE !?20,"This may take a while.  PG XREF INITIALIZATION",!

           SET LRDFN=0

DFN        WRITE "."

           SET LRDFN=$ORDER(^LR(LRDFN))

           IF LRDFN<1

               QUIT 

           IF $DATA(^LR(LRDFN,"PG"))

               WRITE LRDFN," "

               KILL ^LR(LRDFN,"PG")

 +1        GOTO DFN