LRAC7.m

LRAC7 ;SLC/DCM - SET-UP FOR THE KILL ; 8/11/87  09:41 ;

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

LRFD1 S LRFD1=0 F  S LRFD1=$O(^TMP($J,"K",LRFD,LRFD1)) Q:LRFD1<1  S ^LAC("LRKILL",LRDFN,LRMH,1,LRFD,LRFD1)=^TMP($J,"K",LRFD,LRFD1)

 Q:'$D(^LR(LRDFN,"CH",K(1),0))  S P=$P(^(0),U,9),$P(^LR(LRDFN,"CH",K(1),0),U,9)=$S(P[(LRMH_":"_LRPG):P,P[":":P_","_LRMH_":"_LRPG,1:LRMH_":"_LRPG)

 Q

ENT ;from LRAC6

 Q:LRRE  S ^LR(LRDFN,"PG",LRMH)=LRMH_U_LRPG S LRFD=0 F  S LRFD=$O(^TMP($J,"K",LRFD)) Q:LRFD<1  S:'$D(^(LRFD,0))#2 ^(0)=9999999-LRFD S ^LAC("LRKILL",LRDFN,LRMH,1,LRFD,0)=^(0),K(1)=$P(^(0),U,1) D LRFD1

 K LRFD,K Q

OVFL ;from LRAC4, LRAC9

 S LRFULL=1 W !!?10,"Comments continued on next page..." D HEAD1^LRAC6,HEAD^LRAC6 W !!!?10,"...",LRSHN," comments continued.",!

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---LRAC7   763     printed  Feb 18, 2025@23:32:05                                                                                                                                                                                                        Page 2

LRAC7     ;SLC/DCM - SET-UP FOR THE KILL ; 8/11/87  09:41 ;

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

LRFD1      SET LRFD1=0

           FOR 

               SET LRFD1=$ORDER(^TMP($JOB,"K",LRFD,LRFD1))

               if LRFD1<1

                   QUIT 

               SET ^LAC("LRKILL",LRDFN,LRMH,1,LRFD,LRFD1)=^TMP($JOB,"K",LRFD,LRFD1)

 +1        if '$DATA(^LR(LRDFN,"CH",K(1),0))

               QUIT 

           SET P=$PIECE(^(0),U,9)

           SET $PIECE(^LR(LRDFN,"CH",K(1),0),U,9)=$SELECT(P[(LRMH_":"_LRPG):P,P[":":P_","_LRMH_":"_LRPG,1:LRMH_":"_LRPG)

 +2        QUIT 

ENT       ;from LRAC6

 +1        if LRRE

               QUIT 

           SET ^LR(LRDFN,"PG",LRMH)=LRMH_U_LRPG

           SET LRFD=0

           FOR 

               SET LRFD=$ORDER(^TMP($JOB,"K",LRFD))

               if LRFD<1

                   QUIT 

               if '$DATA(^(LRFD,0))#2

                   SET ^(0)=9999999-LRFD

               SET ^LAC("LRKILL",LRDFN,LRMH,1,LRFD,0)=^(0)

               SET K(1)=$PIECE(^(0),U,1)

               DO LRFD1

 +2        KILL LRFD,K

           QUIT 

OVFL      ;from LRAC4, LRAC9

 +1        SET LRFULL=1

           WRITE !!?10,"Comments continued on next page..."

           DO HEAD1^LRAC6

           DO HEAD^LRAC6

           WRITE !!!?10,"...",LRSHN," comments continued.",!

 +2        QUIT