BLRALBD.m

BLRALBD ;DAOU/ALA-Build data for a selected accession [ 11/18/2002  1:32 PM ]

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

 ;

 ;**Program Description**

 ;  This program will build the lab result data for a

 ;  selected accession.

 ;

 ;  Input Parameters

 ;    LRDFN = Lab Patient IEN

 ;    LRIDT = Lab Result Reverse Date

 ;    LRSS  = Lab Result Type ('CH', 'MI', etc.)

 ;

CH ;EP

 ; Clinical Chemistry

 K ^TMP("LR",$J,"TP"),LRTP,^TMP($J,"BLRA"),LRORD

 ;

 ;  Set patient data which needs LRDFN

 D PT^LRX

 ;  returns variables needed for header in HDR^BLRALBA

 ;D HDR^BLRALBA

 ;

 S:'$D(LRTSCRN) LRTSCRN=0

 S LRLAB=$S($D(LRLABKY):1,1:0),LRHF=1,LRFOOT=0,LRCW=8

 S LR0=$G(^LR(LRDFN,"CH",LRIDT,0)) Q:'$P(LR0,U,3)

 S LRCDT=+LR0,LRSS="CH",LROC=$P(LR0,U,11),LRAA=""

 S LRAAO=1,LRTC=0,LRSPEC=$P(LR0,U,5),LRDN=1

 ;

 ;  Loop through and setup lab tests

 F  S LRDN=$O(^LR(LRDFN,"CH",LRIDT,LRDN)) Q:LRDN<1  D

 . S LRTSTS=$O(^LAB(60,"C","CH;"_LRDN_";1",0)) D SETUP^LRRP

 ;

 ;  Setup comments

 D CMNT^LRRP

 ;

 ;  Builds ^TMP($J,"BLRA",#,0) for display

 D ^BLRALBA

 ;  returns the total number of lines = BLRADSP

 Q

 ;

MI ;EP

 ; Microbiology

 S BLRADSP=0,$P(BLRABLKS," ",80)=""

 K ^TMP($J,"BLRA")

 ;

 ;  Builds ^TMP($J,"BLRA",#,0) for display

 D ^BLRALBM

 ;  returns the total number of lines = BLRADSP

 Q

BLRALBD   ;DAOU/ALA-Build data for a selected accession [ 11/18/2002  1:32 PM ]

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

 +2       ;

 +3       ;**Program Description**

 +4       ;  This program will build the lab result data for a

 +5       ;  selected accession.

 +6       ;

 +7       ;  Input Parameters

 +8       ;    LRDFN = Lab Patient IEN

 +9       ;    LRIDT = Lab Result Reverse Date

 +10      ;    LRSS  = Lab Result Type ('CH', 'MI', etc.)

 +11      ;

CH        ;EP

 +1       ; Clinical Chemistry

 +2        KILL ^TMP("LR",$JOB,"TP"),LRTP,^TMP($JOB,"BLRA"),LRORD

 +3       ;

 +4       ;  Set patient data which needs LRDFN

 +5        DO PT^LRX

 +6       ;  returns variables needed for header in HDR^BLRALBA

 +7       ;D HDR^BLRALBA

 +8       ;

 +9        IF '$DATA(LRTSCRN)

               SET LRTSCRN=0

 +10       SET LRLAB=$SELECT($DATA(LRLABKY):1,1:0)

           SET LRHF=1

           SET LRFOOT=0

           SET LRCW=8

 +11       SET LR0=$GET(^LR(LRDFN,"CH",LRIDT,0))

           IF '$PIECE(LR0,U,3)

               QUIT 

 +12       SET LRCDT=+LR0

           SET LRSS="CH"

           SET LROC=$PIECE(LR0,U,11)

           SET LRAA=""

 +13       SET LRAAO=1

           SET LRTC=0

           SET LRSPEC=$PIECE(LR0,U,5)

           SET LRDN=1

 +14      ;

 +15      ;  Loop through and setup lab tests

 +16       FOR 

               SET LRDN=$ORDER(^LR(LRDFN,"CH",LRIDT,LRDN))

               IF LRDN<1

                   QUIT 

               Begin DoDot:1

 +17               SET LRTSTS=$ORDER(^LAB(60,"C","CH;"_LRDN_";1",0))

                   DO SETUP^LRRP

               End DoDot:1

 +18      ;

 +19      ;  Setup comments

 +20       DO CMNT^LRRP

 +21      ;

 +22      ;  Builds ^TMP($J,"BLRA",#,0) for display

 +23       DO ^BLRALBA

 +24      ;  returns the total number of lines = BLRADSP

 +25       QUIT 

 +26      ;

MI        ;EP

 +1       ; Microbiology

 +2        SET BLRADSP=0

           SET $PIECE(BLRABLKS," ",80)=""

 +3        KILL ^TMP($JOB,"BLRA")

 +4       ;

 +5       ;  Builds ^TMP($J,"BLRA",#,0) for display

 +6        DO ^BLRALBM

 +7       ;  returns the total number of lines = BLRADSP

 +8        QUIT