BLRPARAM.m

BLRPARAM ; IHS/HQT/MJL - IHS LAB SETUP PARAMETERS ; [ 12/19/2002  7:23 AM ]

 ;;5.2;LR;**1010,1015**;NOV 18, 2002

INIT ;EP

 S BLRFID="9009022",BLRLPKG=$O(^DIC(9.4,"C","LR",""))

 S BLRQSITE=$P($G(^AUTTSITE(1,0)),U)

 ;

 ;SET UP AUDITING IF NEEDED

 S SNAPSHOT=$P($G(^BLRSITE(BLRQSITE,0)),U,10) ;/IHS/ITSC/TPF 4/28/01

 ;D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTERED INIT^BLRPARAM")  ;/IHS/ITSC/TPF 4/27/01

 ;

 S BLRFDN=0 F  S BLRFDN=$O(^DD(BLRFID,BLRFDN)) Q:'BLRFDN  S BLRX=$G(^DD(BLRFID,BLRFDN,0)) D

 .S BLRFDNM=$P(BLRX,U)

 .S BLRF(0,BLRFDNM)=BLRFDN

 .Q:'$P(BLRX,U,2)

 .S BLRFMN=+$P(BLRX,U,2)

 .;SETS UP THE BLRF ARRAY CONTAINING THE FIELDS TO SET UP IN BLRTXLOG

 .;SETTING UP THE FDA ARRAY TO UPDATE IS DEPENDENT ON THIS ARRAY 

 .S BLRFDN1=0

 .F  S BLRFDN1=$O(^DD(BLRFMN,BLRFDN1)) Q:'BLRFDN1  S BLRX=$G(^DD(BLRFMN,BLRFDN1,0)) D

 ..S BLRFDNM1=$P(BLRX,U),BLRF(0,BLRFDNM1)=BLRFDN1,BLRF(0,BLRFDNM1,"TYPE")=$S($P(BLRX,U,2)="W":"W",1:"M"),BLRF(0,BLRFDNM1,"FILE")=BLRFMN

 ; This sets the kill string for this multiple-field which is executed 

 ; if present in MULTI^BLRNFLTL.

 S BLRF(0,"COMMENTS","DIK")="S BLRMI=0 F  S BLRMI=$O(^BLRTXLOG(BLRENT,30,BLRMI)) Q:'BLRMI  S DA=BLRMI,DA(1)=BLRENT,DIK=""^BLRTXLOG(""_DA(1)_"",""_30_"","" D ^DIK"

 K BLRFDN,BLRFDNM,BLRFDNM1,BLRFDN,BLRFDN1,BLRFMN,BLRX

 Q

 ;

JOB ;EP

 L +^BLRLOCK:0 Q:'$T

 S BLRQUIET=1

 S ZTIO="",ZTSAVE("BLRQUIET")=""

 S ZTRTN="TSK^BLRTN",ZTDTH=$H

 S ZTDESC="BLRTN task"

 D ^%ZTLOAD

 L -^BLRLOCK

 Q

BLRPARAM  ; IHS/HQT/MJL - IHS LAB SETUP PARAMETERS ; [ 12/19/2002  7:23 AM ]

 +1       ;;5.2;LR;**1010,1015**;NOV 18, 2002

INIT      ;EP

 +1        SET BLRFID="9009022"

           SET BLRLPKG=$ORDER(^DIC(9.4,"C","LR",""))

 +2        SET BLRQSITE=$PIECE($GET(^AUTTSITE(1,0)),U)

 +3       ;

 +4       ;SET UP AUDITING IF NEEDED

 +5       ;/IHS/ITSC/TPF 4/28/01

           SET SNAPSHOT=$PIECE($GET(^BLRSITE(BLRQSITE,0)),U,10)

 +6       ;D:$G(SNAPSHOT) ENTRYAUD^BLRUTIL("ENTERED INIT^BLRPARAM")  ;/IHS/ITSC/TPF 4/27/01

 +7       ;

 +8        SET BLRFDN=0

           FOR 

               SET BLRFDN=$ORDER(^DD(BLRFID,BLRFDN))

               IF 'BLRFDN

                   QUIT 

               SET BLRX=$GET(^DD(BLRFID,BLRFDN,0))

               Begin DoDot:1

 +9                SET BLRFDNM=$PIECE(BLRX,U)

 +10               SET BLRF(0,BLRFDNM)=BLRFDN

 +11               IF '$PIECE(BLRX,U,2)

                       QUIT 

 +12               SET BLRFMN=+$PIECE(BLRX,U,2)

 +13      ;SETS UP THE BLRF ARRAY CONTAINING THE FIELDS TO SET UP IN BLRTXLOG

 +14      ;SETTING UP THE FDA ARRAY TO UPDATE IS DEPENDENT ON THIS ARRAY 

 +15               SET BLRFDN1=0

 +16               FOR 

                       SET BLRFDN1=$ORDER(^DD(BLRFMN,BLRFDN1))

                       IF 'BLRFDN1

                           QUIT 

                       SET BLRX=$GET(^DD(BLRFMN,BLRFDN1,0))

                       Begin DoDot:2

 +17                       SET BLRFDNM1=$PIECE(BLRX,U)

                           SET BLRF(0,BLRFDNM1)=BLRFDN1

                           SET BLRF(0,BLRFDNM1,"TYPE")=$SELECT($PIECE(BLRX,U,2)="W":"W",1:"M")

                           SET BLRF(0,BLRFDNM1,"FILE")=BLRFMN

                       End DoDot:2

               End DoDot:1

 +18      ; This sets the kill string for this multiple-field which is executed 

 +19      ; if present in MULTI^BLRNFLTL.

 +20       SET BLRF(0,"COMMENTS","DIK")="S BLRMI=0 F  S BLRMI=$O(^BLRTXLOG(BLRENT,30,BLRMI)) Q:'BLRMI  S DA=BLRMI,DA(1)=BLRENT,DIK=""^BLRTXLOG(""_DA(1)_"",""_30_"","" D ^DIK"

 +21       KILL BLRFDN,BLRFDNM,BLRFDNM1,BLRFDN,BLRFDN1,BLRFMN,BLRX

 +22       QUIT 

 +23      ;

JOB       ;EP

 +1        LOCK +^BLRLOCK:0

           IF '$TEST

               QUIT 

 +2        SET BLRQUIET=1

 +3        SET ZTIO=""

           SET ZTSAVE("BLRQUIET")=""

 +4        SET ZTRTN="TSK^BLRTN"

           SET ZTDTH=$HOROLOG

 +5        SET ZTDESC="BLRTN task"

 +6        DO ^%ZTLOAD

 +7        LOCK -^BLRLOCK

 +8        QUIT