LRACPG.m

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

 ;;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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRACPG   458     printed  Dec 13, 2024@02:06:30                                                                                                                                                                                                       Page 2

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

 +1       ;;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