LRBLPED2.m

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 ---LRBLPED2   1201     printed  Apr 09, 2024@21:10:39                                                                                                                                                                                                    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