BLRALSR.m

BLRALSR ;DAOU/ALA-Lab Review Signing Report 

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

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

 ;

 ;**Program Description**

 ;  This program sets up the data for the report which

 ;  tells who signed for who.

 ;

EN ;

 K Y,BLRNS,BLRABDT,BLRAEDT

 D EN^DDIOL("","","!!")

 S %DT("A")="Select START DATE for Report: ",%DT="AE" D ^%DT

 Q:Y<0!(Y["^")

 S BLRABDT=Y

 S %DT("A")="Select END DATE for Report: ",%DT="AE" D ^%DT

 Q:Y<0!(Y["^")

 S BLRAEDT=Y

 I BLRAEDT<BLRABDT D

 . W !!,"The END DATE is 'LESS' than START DATE"

 . R !,"Press return to continue, or '^' to Quit",BLRNS:DTIME

 Q:$G(BLRNS)[U

 I $D(BLRNS) G EN

 ;

 S BLRABDT=BLRABDT+.000001,BLRAEDT=BLRAEDT+.999999

 ;

 K ^TMP("BLRASIGN",$J),%DT,Y,BLRNS

 S BLRADUZ=DUZ D FND

 ;

 D EN^BLRAL4

 ;

 K BLRA0,BLRACCN,BLRADATA,BLRADT,BLRADTT,BLRADUZ,BLRALINE,BLRALVAR

 K BLRAOPH,BLRAOPNM,BLRAP,BLRAPFL,BLRAPIEN,BLRAPNM,BLRARPHY,BLRVD

 K BLRSS,BLRARPNM,BLRASDTM,BLRASPHY,BLRASPNM,BLRIDT

 Q

FND ;  Find results

 S BLRVD=""

 F  S BLRVD=$O(^LR("BLRA",BLRADUZ,2,BLRVD)) Q:BLRVD=""  D

 . S BLRAP=""

 . F  S BLRAP=$O(^LR("BLRA",BLRADUZ,2,BLRVD,BLRAP)) Q:BLRAP=""  D

 .. ;S BLRIDT=$P(BLRVD,"-",2),BLRSS=$G(^LR("BLRA",BLRADUZ,2,BLRVD,BLRAP))

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

 .. S BLRSS=""

 .. F  S BLRSS=$O(^LR("BLRA",BLRADUZ,2,BLRVD,BLRAP,BLRSS)) Q:BLRSS=""  D

 ... S BLRIDT=$P(BLRVD,"-",2)

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

 ... S BLRA0=$G(^LR(BLRAP,BLRSS,BLRIDT,0)),BLRACCN=$P(BLRA0,U,6)

 ... S BLRADTT=$P(BLRA0,U,1)

 ... S BLRADATA=$G(^LR(BLRAP,BLRSS,BLRIDT,9009027))

 ...;----- BEGIN IHS MODIFICATIONS LR*5.2*1016 IHS TESTING CHANGES

 ...Q:BLRADATA=""

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

 ... ;

 ... S BLRARPHY=$P(BLRADATA,U,2),BLRARPNM=$P($G(^VA(200,BLRARPHY,0)),U,1)

 ... ;

 ... S BLRASPHY=$P(BLRADATA,U,3),BLRASPNM=$P($G(^VA(200,BLRASPHY,0)),U,1)

 ... ;

 ... S BLRAOPH=$P(BLRA0,U,$S(BLRSS="MI":7,1:10)),BLRAOPNM=$P($G(^VA(200,BLRAOPH,0)),U,1)

 ... S BLRAPFL=$P($G(^LR(BLRAP,0)),U,2),BLRAPIEN=$P($G(^(0)),U,3)

 ... S BLRAPNM=$$GET1^DIQ(BLRAPFL,BLRAPIEN,.01,"E")

 ... ;

 ... S BLRASDTM=$P(BLRADATA,U,5)

 ... Q:BLRASDTM<BLRABDT!(BLRASDTM>BLRAEDT)

 ... ;

 ... S ^TMP("BLRASIGN",$J,-BLRVD,BLRAP,BLRSS)=BLRACCN_U_BLRAPNM_U_$$FMTE^XLFDT(BLRADTT,2)_U_BLRARPNM_U_BLRASPNM_U_$$FMTE^XLFDT(BLRASDTM,2)

 Q

BLRALSR   ;DAOU/ALA-Lab Review Signing Report 

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

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

 +3       ;

 +4       ;**Program Description**

 +5       ;  This program sets up the data for the report which

 +6       ;  tells who signed for who.

 +7       ;

EN        ;

 +1        KILL Y,BLRNS,BLRABDT,BLRAEDT

 +2        DO EN^DDIOL("","","!!")

 +3        SET %DT("A")="Select START DATE for Report: "

           SET %DT="AE"

           DO ^%DT

 +4        IF Y<0!(Y["^")

               QUIT 

 +5        SET BLRABDT=Y

 +6        SET %DT("A")="Select END DATE for Report: "

           SET %DT="AE"

           DO ^%DT

 +7        IF Y<0!(Y["^")

               QUIT 

 +8        SET BLRAEDT=Y

 +9        IF BLRAEDT<BLRABDT

               Begin DoDot:1

 +10               WRITE !!,"The END DATE is 'LESS' than START DATE"

 +11               READ !,"Press return to continue, or '^' to Quit",BLRNS:DTIME

               End DoDot:1

 +12       IF $GET(BLRNS)[U

               QUIT 

 +13       IF $DATA(BLRNS)

               GOTO EN

 +14      ;

 +15       SET BLRABDT=BLRABDT+.000001

           SET BLRAEDT=BLRAEDT+.999999

 +16      ;

 +17       KILL ^TMP("BLRASIGN",$JOB),%DT,Y,BLRNS

 +18       SET BLRADUZ=DUZ

           DO FND

 +19      ;

 +20       DO EN^BLRAL4

 +21      ;

 +22       KILL BLRA0,BLRACCN,BLRADATA,BLRADT,BLRADTT,BLRADUZ,BLRALINE,BLRALVAR

 +23       KILL BLRAOPH,BLRAOPNM,BLRAP,BLRAPFL,BLRAPIEN,BLRAPNM,BLRARPHY,BLRVD

 +24       KILL BLRSS,BLRARPNM,BLRASDTM,BLRASPHY,BLRASPNM,BLRIDT

 +25       QUIT 

FND       ;  Find results

 +1        SET BLRVD=""

 +2        FOR 

               SET BLRVD=$ORDER(^LR("BLRA",BLRADUZ,2,BLRVD))

               IF BLRVD=""

                   QUIT 

               Begin DoDot:1

 +3                SET BLRAP=""

 +4                FOR 

                       SET BLRAP=$ORDER(^LR("BLRA",BLRADUZ,2,BLRVD,BLRAP))

                       IF BLRAP=""

                           QUIT 

                       Begin DoDot:2

 +5       ;S BLRIDT=$P(BLRVD,"-",2),BLRSS=$G(^LR("BLRA",BLRADUZ,2,BLRVD,BLRAP))

 +6       ;----- BEGIN IHS MODIFICATIONS LR*5.2

 +7                        SET BLRSS=""

 +8                        FOR 

                               SET BLRSS=$ORDER(^LR("BLRA",BLRADUZ,2,BLRVD,BLRAP,BLRSS))

                               IF BLRSS=""

                                   QUIT 

                               Begin DoDot:3

 +9                                SET BLRIDT=$PIECE(BLRVD,"-",2)

 +10      ;----- END IHS MODIFICATIONS

 +11                               SET BLRA0=$GET(^LR(BLRAP,BLRSS,BLRIDT,0))

                                   SET BLRACCN=$PIECE(BLRA0,U,6)

 +12                               SET BLRADTT=$PIECE(BLRA0,U,1)

 +13                               SET BLRADATA=$GET(^LR(BLRAP,BLRSS,BLRIDT,9009027))

 +14      ;----- BEGIN IHS MODIFICATIONS LR*5.2*1016 IHS TESTING CHANGES

 +15                               IF BLRADATA=""

                                       QUIT 

 +16      ;----- END IHS MODIFICATIONS

 +17      ;

 +18                               SET BLRARPHY=$PIECE(BLRADATA,U,2)

                                   SET BLRARPNM=$PIECE($GET(^VA(200,BLRARPHY,0)),U,1)

 +19      ;

 +20                               SET BLRASPHY=$PIECE(BLRADATA,U,3)

                                   SET BLRASPNM=$PIECE($GET(^VA(200,BLRASPHY,0)),U,1)

 +21      ;

 +22                               SET BLRAOPH=$PIECE(BLRA0,U,$SELECT(BLRSS="MI":7,1:10))

                                   SET BLRAOPNM=$PIECE($GET(^VA(200,BLRAOPH,0)),U,1)

 +23                               SET BLRAPFL=$PIECE($GET(^LR(BLRAP,0)),U,2)

                                   SET BLRAPIEN=$PIECE($GET(^(0)),U,3)

 +24                               SET BLRAPNM=$$GET1^DIQ(BLRAPFL,BLRAPIEN,.01,"E")

 +25      ;

 +26                               SET BLRASDTM=$PIECE(BLRADATA,U,5)

 +27                               IF BLRASDTM<BLRABDT!(BLRASDTM>BLRAEDT)

                                       QUIT 

 +28      ;

 +29                               SET ^TMP("BLRASIGN",$JOB,-BLRVD,BLRAP,BLRSS)=BLRACCN_U_BLRAPNM_U_$$FMTE^XLFDT(BLRADTT,2)_U_BLRARPNM_U_BLRASPNM_U_$$FMTE^XLFDT(BLRASDTM,2)

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +30       QUIT