LRBLPED2 ;AVAMC/REG - PROCESS PEDIATRIC UNIT ;2/4/93 12:07 ; 12/13/00 1:54pm
;;5.2;LAB SERVICE;**247,267**;Sep 27, 1994
;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
S:'$D(^LRD(65,DA,16,0)) ^(0)="^65.16^^" L +^LRD(65,DA,16) S X=^LRD(65,DA,16,0),X(3)=$P(X,"^",3)+1,^(0)=$P(X,"^",1,2)_"^"_X(3)_"^"_($P(X,"^",4)+1) L -^LRD(65,DA,16)
S ^LRD(65,DA,16,X(3),0)=LRI_"^"_LRV(1),X=LRV(2)-LRV(1),$P(^LRD(65,DA,0),"^",11)=X
I X<1 S DIE=65,DR="4.1///^S X=""D"";4.2///^S X=""N"";4.3////^S X=DUZ" D ^DIE S ^LRD(65,DA,5,0)="^65.06A^1^1",^(1,0)="Pediatric unit prep"
S (DIC,DIE)=65,DIC(0)="FL",DLAYGO=65,X=""""_LRI_"""" D ^DIC
S DA=+Y,DR=".02///SELF;.03///00;.04///^S X=LRP;.05///^S X=LRK;.06////^S X=LRE(1);.07///^S X=LRABO;.08///^S X=LRRH;.09////^S X=DUZ;.11///^S X=LRV(1);.16////^S X=DUZ(2)" D ^DIE D:LRCAPA ^LRBLW
S ^LRD(65,DA,9,0)="^65.091PAI^1^1",^(1,0)=LRC_"^"_$P(LRF,"^",2),A=+LRF
F B=60,70,80,90 I $D(^LRD(65,A,B,0)),$P(^(0),"^",4) S %X="^LRD(65,A,B,",%Y="^LRD(65,DA,B," D %XY^%RCR
S $P(^LRD(65,DA,0),"^",15)=$P(^LRD(65,A,0),"^",15)
S LRX=DA D:LRZ EN^LRBLDRR1 I 'LRZ F X=10,11 I $D(^LRD(65,A,X)) S X(1)=^(X),^LRD(65,N,X)=X(1)
K DLAYGO
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRBLPED2 1201 printed Nov 22, 2024@17:21:58 Page 2
LRBLPED2 ;AVAMC/REG - PROCESS PEDIATRIC UNIT ;2/4/93 12:07 ; 12/13/00 1:54pm
+1 ;;5.2;LAB SERVICE;**247,267**;Sep 27, 1994
+2 ;Per VHA Directive 97-033 this routine should not be modified. Medical Device # BK970021
+3 if '$DATA(^LRD(65,DA,16,0))
SET ^(0)="^65.16^^"
LOCK +^LRD(65,DA,16)
SET X=^LRD(65,DA,16,0)
SET X(3)=$PIECE(X,"^",3)+1
SET ^(0)=$PIECE(X,"^",1,2)_"^"_X(3)_"^"_($PIECE(X,"^",4)+1)
LOCK -^LRD(65,DA,16)
+4 SET ^LRD(65,DA,16,X(3),0)=LRI_"^"_LRV(1)
SET X=LRV(2)-LRV(1)
SET $PIECE(^LRD(65,DA,0),"^",11)=X
+5 IF X<1
SET DIE=65
SET DR="4.1///^S X=""D"";4.2///^S X=""N"";4.3////^S X=DUZ"
DO ^DIE
SET ^LRD(65,DA,5,0)="^65.06A^1^1"
SET ^(1,0)="Pediatric unit prep"
+6 SET (DIC,DIE)=65
SET DIC(0)="FL"
SET DLAYGO=65
SET X=""""_LRI_""""
DO ^DIC
+7 SET DA=+Y
SET DR=".02///SELF;.03///00;.04///^S X=LRP;.05///^S X=LRK;.06////^S X=LRE(1);.07///^S X=LRABO;.08///^S X=LRRH;.09////^S X=DUZ;.11///^S X=LRV(1);.16////^S X=DUZ(2)"
DO ^DIE
if LRCAPA
DO ^LRBLW
+8 SET ^LRD(65,DA,9,0)="^65.091PAI^1^1"
SET ^(1,0)=LRC_"^"_$PIECE(LRF,"^",2)
SET A=+LRF
+9 FOR B=60,70,80,90
IF $DATA(^LRD(65,A,B,0))
IF $PIECE(^(0),"^",4)
SET %X="^LRD(65,A,B,"
SET %Y="^LRD(65,DA,B,"
DO %XY^%RCR
+10 SET $PIECE(^LRD(65,DA,0),"^",15)=$PIECE(^LRD(65,A,0),"^",15)
+11 SET LRX=DA
if LRZ
DO EN^LRBLDRR1
IF 'LRZ
FOR X=10,11
IF $DATA(^LRD(65,A,X))
SET X(1)=^(X)
SET ^LRD(65,N,X)=X(1)
+12 KILL DLAYGO
+13 QUIT
