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 ---[H[J[2J[HLRAC7 763 printed Nov 22, 2024@17:16:17 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
