BLRAL1.m

BLRAL1 ;MTK/CR-ListMan program for Lab Results 

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

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

 ;; ;

EN ;EP

 ; -- main entry point for BLRA LAB RESULTS LIST

 D EN^VALM("BLRA LAB RESULTS LIST")

 Q

 ;

HDR ; -- header code

 S VALMHDR(1)=$G(BLRAHDR)_" "

 S VALMHDR(2)=" "

 S VALMHDR(3)="WARNING: RESTRICTED GOVERNMENT DATA, UNAUTHORIZED ENTRY/USE IS A FEDERAL CRIME"

 Q

 ;

INIT ;EP

 ;  -- init variables and list array

 D CLEAN^VALM10    ;Clears screen before display of list

 ;GET/SETUP THE REVERSE VIDEO FOR THE STATUS FIELD

 S X="IORVON;IORVOFF;IOIL;IOSTBM;IOSC;IORC;IOEDEOP;IOINHI;IOINORM;IOUON;IOUOFF" D ENDR^%ZISS

RBLD S BLRALNUM="",BLRADT="",BLRALINE=0,BLRALVAR=""

 S TYP=""

 F  S TYP=$O(^TMP("BLRA",$J,TYP)) Q:TYP=""  D

 . S BLRADT=""

 . F  S BLRADT=$O(^TMP("BLRA",$J,TYP,BLRADT)) Q:BLRADT=""  D

 .. S BLRAP=""

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

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

 ... S BLRSS=""

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

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

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

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

 ....S PID=$P($G(^TMP("BLRA",$J,TYP,BLRADT,BLRAP,BLRSS)),U,4)

 ....S DATE=$P($G(^TMP("BLRA",$J,TYP,BLRADT,BLRAP,BLRSS)),U,3)

 ....S DATE=$$FMTE^XLFDT(DATE,2)

 ....S PNAM=$$GET1^DIQ(200,PID,.01,"E")

 ....S BLRALVAR=$$SETFLD^VALM1(BLRALINE,BLRALVAR,"LINE NUMBER")

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

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

 ....S BLRALVAR=$$SETFLD^VALM1(DATE,BLRALVAR,"DATE")

 ....S BLRALVAR=$$SETFLD^VALM1(PNAM,BLRALVAR,"PROVIDER")

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

 ....S BLRALVAR=$$SETFLD^VALM1($P(BLRADATA,U,6),BLRALVAR,"COMPLETE")

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

 ....S $P(^TMP("BLRA",$J,TYP,BLRADT,BLRAP,BLRSS),U,7)=BLRALINE

 ....I $P(BLRADATA,U,5)="ABN" D CNTRL^VALM10(BLRALINE,63,3,IORVON,IORVOFF)

 .... I $P(BLRADATA,U,5)="CRIT" D CNTRL^VALM10(BLRALINE,63,4,IORVON,IORVOFF)

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

 I BLRALINE=0 S VALMSG="No Lab Results to Review at this time"

 Q

 ;

HELP ; -- help code

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

 Q

 ;

EXIT ; -- exit code

 K ^TMP("BLRALST1",$J),^TMP("BLRA",$J)

 S VALMBCK=""

 Q

 ;

EXPND ; -- expand code

 Q

 ;

BLRAL1    ;MTK/CR-ListMan program for Lab Results 

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

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

 +3       ;; ;

EN        ;EP

 +1       ; -- main entry point for BLRA LAB RESULTS LIST

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

 +3        QUIT 

 +4       ;

HDR       ; -- header code

 +1        SET VALMHDR(1)=$GET(BLRAHDR)_" "

 +2        SET VALMHDR(2)=" "

 +3        SET VALMHDR(3)="WARNING: RESTRICTED GOVERNMENT DATA, UNAUTHORIZED ENTRY/USE IS A FEDERAL CRIME"

 +4        QUIT 

 +5       ;

INIT      ;EP

 +1       ;  -- init variables and list array

 +2       ;Clears screen before display of list

           DO CLEAN^VALM10

 +3       ;GET/SETUP THE REVERSE VIDEO FOR THE STATUS FIELD

 +4        SET X="IORVON;IORVOFF;IOIL;IOSTBM;IOSC;IORC;IOEDEOP;IOINHI;IOINORM;IOUON;IOUOFF"

           DO ENDR^%ZISS

RBLD       SET BLRALNUM=""

           SET BLRADT=""

           SET BLRALINE=0

           SET BLRALVAR=""

 +1        SET TYP=""

 +2        FOR 

               SET TYP=$ORDER(^TMP("BLRA",$JOB,TYP))

               IF TYP=""

                   QUIT 

               Begin DoDot:1

 +3                SET BLRADT=""

 +4                FOR 

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

                       IF BLRADT=""

                           QUIT 

                       Begin DoDot:2

 +5                        SET BLRAP=""

 +6                        FOR 

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

                               IF BLRAP=""

                                   QUIT 

                               Begin DoDot:3

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

 +8                                SET BLRSS=""

 +9                                FOR 

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

                                       IF BLRSS=""

                                           QUIT 

                                       Begin DoDot:4

 +10      ;----- END IHS MODIFICATIONS

 +11                                       SET BLRALINE=BLRALINE+1

                                           SET BLRALVAR=""

 +12                                       SET BLRADATA=$GET(^TMP("BLRA",$JOB,TYP,BLRADT,BLRAP,BLRSS))

 +13                                       SET PID=$PIECE($GET(^TMP("BLRA",$JOB,TYP,BLRADT,BLRAP,BLRSS)),U,4)

 +14                                       SET DATE=$PIECE($GET(^TMP("BLRA",$JOB,TYP,BLRADT,BLRAP,BLRSS)),U,3)

 +15                                       SET DATE=$$FMTE^XLFDT(DATE,2)

 +16                                       SET PNAM=$$GET1^DIQ(200,PID,.01,"E")

 +17                                       SET BLRALVAR=$$SETFLD^VALM1(BLRALINE,BLRALVAR,"LINE NUMBER")

 +18                                       SET BLRALVAR=$$SETFLD^VALM1($PIECE(BLRADATA,U,1),BLRALVAR,"ACC#")

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

 +20                                       SET BLRALVAR=$$SETFLD^VALM1(DATE,BLRALVAR,"DATE")

 +21                                       SET BLRALVAR=$$SETFLD^VALM1(PNAM,BLRALVAR,"PROVIDER")

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

 +23                                       SET BLRALVAR=$$SETFLD^VALM1($PIECE(BLRADATA,U,6),BLRALVAR,"COMPLETE")

 +24                                       DO SET^VALM10(BLRALINE,BLRALVAR)

 +25                                       SET $PIECE(^TMP("BLRA",$JOB,TYP,BLRADT,BLRAP,BLRSS),U,7)=BLRALINE

 +26                                       IF $PIECE(BLRADATA,U,5)="ABN"

                                               DO CNTRL^VALM10(BLRALINE,63,3,IORVON,IORVOFF)

 +27                                       IF $PIECE(BLRADATA,U,5)="CRIT"

                                               DO CNTRL^VALM10(BLRALINE,63,4,IORVON,IORVOFF)

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

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

           SET VALMCNT=BLRALINE

 +29       IF BLRALINE=0

               SET VALMSG="No Lab Results to Review at this time"

 +30       QUIT 

 +31      ;

HELP      ; -- help code

 +1        SET X="?"

           DO DISP^XQORM1

           WRITE !!

 +2        QUIT 

 +3       ;

EXIT      ; -- exit code

 +1        KILL ^TMP("BLRALST1",$JOB),^TMP("BLRA",$JOB)

 +2        SET VALMBCK=""

 +3        QUIT 

 +4       ;

EXPND     ; -- expand code

 +1        QUIT 

 +2       ;