BLRAL3.m

BLRAL3 ;DAOU/ALA-ListMan program for delinquent 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 DELINQ LIST

 D EN^VALM("BLRA LAB RESULT DELINQ 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

 ;

 ;  Get the reverse video

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

 ;

 S BLRALINE=0,BLRAPHY=""

 F  S BLRAPHY=$O(^TMP("BLRADELQ",$J,BLRAPHY)) Q:BLRAPHY=""  D

 . S TYP=""

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

 .. S BLRADT=""

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

 ... S BLRAP=""

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

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

 .... S BLRSS=""

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

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

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

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

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

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

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

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

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

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

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

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

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

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

 ..... ;

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

 ..... I $P(BLRADATA,U,5)="CRIT" D CNTRL^VALM10(BLRALINE,65,4,IORVON_IOBON,IORVOFF_IOBOFF)

 ;

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

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

 Q

 ;

HELP ; -- help code

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

 Q

 ;

EXIT ; -- exit code

 Q

 ;

EXPND ; -- expand code

 Q

 ;

BLRAL3    ;DAOU/ALA-ListMan program for delinquent 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 DELINQ LIST

 +2        DO EN^VALM("BLRA LAB RESULT DELINQ 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       ;  Get the reverse video

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

           DO ENDR^%ZISS

 +5       ;

 +6        SET BLRALINE=0

           SET BLRAPHY=""

 +7        FOR 

               SET BLRAPHY=$ORDER(^TMP("BLRADELQ",$JOB,BLRAPHY))

               IF BLRAPHY=""

                   QUIT 

               Begin DoDot:1

 +8                SET TYP=""

 +9                FOR 

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

                       IF TYP=""

                           QUIT 

                       Begin DoDot:2

 +10                       SET BLRADT=""

 +11                       FOR 

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

                               IF 'BLRADT

                                   QUIT 

                               Begin DoDot:3

 +12                               SET BLRAP=""

 +13                               FOR 

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

                                       IF 'BLRAP

                                           QUIT 

                                       Begin DoDot:4

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

 +15                                       SET BLRSS=""

 +16                                       FOR 

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

                                               IF BLRSS=""

                                                   QUIT 

                                               Begin DoDot:5

 +17      ;----- END IHS MODIFICATIONS

 +18                                               SET BLRALINE=BLRALINE+1

                                                   SET BLRALVAR=""

 +19                                               SET BLRADATA=$GET(^TMP("BLRADELQ",$JOB,BLRAPHY,TYP,BLRADT,BLRAP,BLRSS))

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

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

 +22                                               SET BLRALVAR=$$SETFLD^VALM1(BLRALINE,BLRALVAR,"LINENUMBER")

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

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

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

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

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

 +28                                               SET BLRALVAR=$$SETFLD^VALM1($JUSTIFY($PIECE(BLRADATA,U,6),4),BLRALVAR,"DAYSDELINQ")

 +29                                               DO SET^VALM10(BLRALINE,BLRALVAR)

 +30      ;

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

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

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

                                                       DO CNTRL^VALM10(BLRALINE,65,4,IORVON_IOBON,IORVOFF_IOBOFF)

                                               End DoDot:5

                                       End DoDot:4

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +33      ;

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

           SET VALMCNT=BLRALINE

 +35       IF BLRALINE=0

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

 +36       QUIT 

 +37      ;

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       ;