BLRAL4.m

BLRAL4 ;DAOU/ALA-ListMan program for signed labs 

 ;;5.2T9;LR;**1018**;Nov 17, 2004

 ;;5.2t6;LR;**1013,1015**;Nov 18, 2002

 ;; ;

EN ;EP

 ; -- main entry point for BLRA LAB RESULT SIGN LIST

 D EN^VALM("BLRA LAB RESULT SIGN LIST")

 Q

 ;

HDR ; -- header code

 S VALMHDR(1)=" "

 S VALMHDR(2)=" "

 Q

 ;

INIT ; -- init variables and list array

 D CLEAN^VALM10    ;Clears screen before display of list

 ;

 S BLRALINE=0

 S BLRADT=""

 F  S BLRADT=$O(^TMP("BLRASIGN",$J,BLRADT)) Q:'BLRADT  D

 . S BLRAP=""

 . F  S BLRAP=$O(^TMP("BLRASIGN",$J,BLRADT,BLRAP)) Q:'BLRAP  D

 .. ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 .. S BLRSS=""

 .. F  S BLRSS=$O(^TMP("BLRASIGN",$J,BLRADT,BLRAP,BLRSS)) Q:BLRSS=""  D

 ... ;----- END IHS MODIFICATIONS

 ... S BLRALINE=BLRALINE+1,BLRALVAR=""

 ... ;S BLRADATA=$G(^TMP("BLRASIGN",$J,BLRADT,BLRAP))

 ... ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 ... S BLRADATA=$G(^TMP("BLRASIGN",$J,BLRADT,BLRAP,BLRSS))

 ... ;----- END IHS MODIFICATIONS

 ... S BLRALVAR=$$SETFLD^VALM1($P(BLRADATA,U,1),BLRALVAR,"ACCESSION")

 ... S BLRALVAR=$$SETFLD^VALM1($P(BLRADATA,U,2),BLRALVAR,"PATIENT")

 ... S BLRALVAR=$$SETFLD^VALM1($P(BLRADATA,U,3),BLRALVAR,"LAB DATE")

 ... S BLRALVAR=$$SETFLD^VALM1($P(BLRADATA,U,4),BLRALVAR,"RESPONSIBLE")

 ... S BLRALVAR=$$SETFLD^VALM1($P(BLRADATA,U,5),BLRALVAR,"SIGNING")

 ... S BLRALVAR=$$SETFLD^VALM1($P(BLRADATA,U,6),BLRALVAR,"DATE/TIME SIGNED")

 ... D SET^VALM10(BLRALINE,BLRALVAR)

 ;

 S VALMCNT=BLRALINE   ;IF LINE CNTER IS NULL THEN THERE WERE NO RESULTS

 I BLRALINE=0 S VALMSG="No Signed Lab Results Found"

 Q

 ;

HELP ; -- help code

 S X="?" D DISP^XQORM1 W !!

 Q

 ;

EXIT ; -- exit code

 Q

 ;

EXPND ; -- expand code

 Q

 ;

BLRAL4    ;DAOU/ALA-ListMan program for signed labs 

 +1       ;;5.2T9;LR;**1018**;Nov 17, 2004

 +2       ;;5.2t6;LR;**1013,1015**;Nov 18, 2002

 +3       ;; ;

EN        ;EP

 +1       ; -- main entry point for BLRA LAB RESULT SIGN LIST

 +2        DO EN^VALM("BLRA LAB RESULT SIGN LIST")

 +3        QUIT 

 +4       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)=" "

 +2        SET VALMHDR(2)=" "

 +3        QUIT 

 +4       ;

INIT      ; -- init variables and list array

 +1       ;Clears screen before display of list

           DO CLEAN^VALM10

 +2       ;

 +3        SET BLRALINE=0

 +4        SET BLRADT=""

 +5        FOR 

               SET BLRADT=$ORDER(^TMP("BLRASIGN",$JOB,BLRADT))

               IF 'BLRADT

                   QUIT 

               Begin DoDot:1

 +6                SET BLRAP=""

 +7                FOR 

                       SET BLRAP=$ORDER(^TMP("BLRASIGN",$JOB,BLRADT,BLRAP))

                       IF 'BLRAP

                           QUIT 

                       Begin DoDot:2

 +8       ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 +9                        SET BLRSS=""

 +10                       FOR 

                               SET BLRSS=$ORDER(^TMP("BLRASIGN",$JOB,BLRADT,BLRAP,BLRSS))

                               IF BLRSS=""

                                   QUIT 

                               Begin DoDot:3

 +11      ;----- END IHS MODIFICATIONS

 +12                               SET BLRALINE=BLRALINE+1

                                   SET BLRALVAR=""

 +13      ;S BLRADATA=$G(^TMP("BLRASIGN",$J,BLRADT,BLRAP))

 +14      ;----- BEGIN IHS MODIFICATIONS LR*5.2*1018

 +15                               SET BLRADATA=$GET(^TMP("BLRASIGN",$JOB,BLRADT,BLRAP,BLRSS))

 +16      ;----- END IHS MODIFICATIONS

 +17                               SET BLRALVAR=$$SETFLD^VALM1($PIECE(BLRADATA,U,1),BLRALVAR,"ACCESSION")

 +18                               SET BLRALVAR=$$SETFLD^VALM1($PIECE(BLRADATA,U,2),BLRALVAR,"PATIENT")

 +19                               SET BLRALVAR=$$SETFLD^VALM1($PIECE(BLRADATA,U,3),BLRALVAR,"LAB DATE")

 +20                               SET BLRALVAR=$$SETFLD^VALM1($PIECE(BLRADATA,U,4),BLRALVAR,"RESPONSIBLE")

 +21                               SET BLRALVAR=$$SETFLD^VALM1($PIECE(BLRADATA,U,5),BLRALVAR,"SIGNING")

 +22                               SET BLRALVAR=$$SETFLD^VALM1($PIECE(BLRADATA,U,6),BLRALVAR,"DATE/TIME SIGNED")

 +23                               DO SET^VALM10(BLRALINE,BLRALVAR)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +24      ;

 +25      ;IF LINE CNTER IS NULL THEN THERE WERE NO RESULTS

           SET VALMCNT=BLRALINE

 +26       IF BLRALINE=0

               SET VALMSG="No Signed Lab Results Found"

 +27       QUIT 

 +28      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        QUIT 

 +2       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;