- 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
