Routine: BARRAGE

BARRAGE ; IHS/SD/LSL - AGING RPT - AGE FEB 4,1997 ;

 ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005

START ; EP

 ; Aging reports -Menu option RPT-Reports menu AGE-Aging Report

 S BAR("SITE")=$P(^DIC(4,DUZ(2),0),"^",1)

 S DIR(0)="S^F:FACILITY;I:INSURER;C:CLINIC;P:PATIENT"

 D ^DIR

 G:Y<0!($D(DUOUT))!($D(DTOUT)) END

 S BAR("SELECTION")=Y(0)

 S BARS=$S(Y(0)="FACILITY":"FAC",Y(0)="INSURER":"INS",Y(0)="PATIENT":"PAT",Y(0)="CLINIC":"CLIN",1:"END")

 D @BARS

 G:$D(BAR("QFLG")) END

 W !!,$$EN^BARVDF("RVN"),"NOTE:",$$EN^BARVDF("RVF")," Output is 132 columns.",!

 D AGE

 D PRINT

END ;

 K BAR,BARS,BARBRZ

 ; *********************************************************************

PRINT ;

 ; Print

 K DIC

S ;

 S DIC="90050.01"

 S L=0

PRINT2 ; EP

 S HDR="@"

 D EN1^DIP

 D ^%ZISC,HOME^%ZIS

 ; *********************************************************************

AGE ;

 ; Age

 S DHD="[BAR AGE HDR]"

 I $G(FR)="" S FR="@",BAR("CNAME")="ALL"

 I $G(TO)="" S TO="zzzzzzzz"

 S FLDS="[BAR AGE PRNT]"

 ; *********************************************************************

FAC ;

 ; Single Facility print

 S BY="[BAR AGE FAC SRT]"

 K DIC

 S DIC("A")="Select Facility or press <RETURN> for all Facilities: "

 S DIC="90052.05"

 S DIC(0)="AEMQZ"

 D ^DIC

 I ($D(DUOUT))!($D(DTOUT)) S BAR("QFLG")=1

 I Y<0 Q

 S BAR("CNAME")=Y(0,0)

 S FR=BAR("CNAME")

 S TO=BAR("CNAME")

 ; *********************************************************************

INS ;

 ;Single Insurer print

 S BY="[BAR AGE SRT]"

 K DIC

 S DIC("A")="Select Insurer or press <RETURN> for all Insurers: "

 S DIC="90050.02"

 S DIC(0)="AEMQZ"

 S DIC("S")="I $P(^(0),U)[""AUT"",$P(^(0),U,10)=$$VALI^XBDIQ1(200,DUZ,29)"

 D ^DIC

 I ($D(DUOUT))!($D(DTOUT)) S BAR("QFLG")=1

 I Y<0 Q

 S BAR("CNAME")=Y(0,0)

 S FR=BAR("CNAME")

 S TO=BAR("CNAME")

 ; *********************************************************************

CLIN ;

 ; Single Clinic print

 S BY="[BAR AGE CLIN SRT]"

 K DIC

 S DIC("A")="Select Clinic or press <RETURN> for all Clinics: "

 S DIC="40.7"

 S DIC(0)="AEMQZ"

 D ^DIC

 I ($D(DUOUT))!($D(DTOUT)) S BAR("QFLG")=1

 I Y<0 Q

 S BAR("CNAME")=Y(0,0)

 S FR=BAR("CNAME")

 S TO=BAR("CNAME")

 ; *********************************************************************

PAT ;

 ; Single Patient print

 S BY="[BAR AGE PAT SRT]"

 K DIC

 ; use dfn in specifying patient (block of lines)

 S DIC("A")="Select Patient or press <RETURN> for all Patients: "

 S DIC="^AUPNPAT("

 S DIC(0)="AEQMZI"

 D ^DIC

 I ($D(DUOUT))!($D(DTOUT)) S BAR("QFLG")=1

 I Y<0 Q

 S DFN=+Y

 S BAR("CNAME")=Y(0,0)

 S FR=DFN

 S TO=DFN

 ; 'end' use dfn in specifying patient

 ; *********************************************************************

XBLM ;

 S Y=$$DIR^XBDIR("S^P:PRINT Output;B:BROWSE Output on Screen","Do you wish to ","P","","","",1)

 K DA

 Q:$D(DIRUT)

 I Y'="B" Q

 S BARBRZ=1

 S XBFLD("BROWSE")=1

 D VIEWD^XBLM("EN1^DIP")

 D FULL^VALM1

 W $$EN^BARVDF("IOF")

 D CLEAR^VALM1 ;clears out all list man stuff

 K XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF

 K VALMCON,VALMDN,VALMEVL,VALMIOXY,VALMKEY,VALMLFT,VALMLST,VALMMENU

 K VALMSGR,VALMUP,VALMWD,VALMY,XQORS,XQORSPEW,VALMCOFF

XBLME ;

BARRAGE   ; IHS/SD/LSL - AGING RPT - AGE FEB 4,1997 ;

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;;OCT 26, 2005

 +2       ;

START     ; EP

 +1       ; Aging reports -Menu option RPT-Reports menu AGE-Aging Report

 +2       ;

 +3        SET BAR("SITE")=$PIECE(^DIC(4,DUZ(2),0),"^",1)

 +4        SET DIR(0)="S^F:FACILITY;I:INSURER;C:CLINIC;P:PATIENT"

 +5        DO ^DIR

 +6        IF Y<0!($DATA(DUOUT))!($DATA(DTOUT))

               GOTO END

 +7        SET BAR("SELECTION")=Y(0)

 +8        SET BARS=$SELECT(Y(0)="FACILITY":"FAC",Y(0)="INSURER":"INS",Y(0)="PATIENT":"PAT",Y(0)="CLINIC":"CLIN",1:"END")

 +9        DO @BARS

 +10       IF $DATA(BAR("QFLG"))

               GOTO END

 +11       WRITE !!,$$EN^BARVDF("RVN"),"NOTE:",$$EN^BARVDF("RVF")," Output is 132 columns.",!

 +12       DO AGE

 +13       DO PRINT

 +14      ;

END       ;

 +1        KILL BAR,BARS,BARBRZ

 +2        QUIT

 +3       ; *********************************************************************

 +4       ;

PRINT     ;

 +1       ; Print

 +2        KILL DIC

 +3       ;

S         ;

 +1        SET DIC="90050.01"

 +2        SET L=0

 +3       ;

PRINT2    ; EP

 +1        SET HDR="@"

 +2        DO EN1^DIP

 +3        DO ^%ZISC

           DO HOME^%ZIS

 +4        QUIT

 +5       ; *********************************************************************

 +6       ;

AGE       ;

 +1       ; Age

 +2        SET DHD="[BAR AGE HDR]"

 +3        IF $GET(FR)=""

               SET FR="@"

               SET BAR("CNAME")="ALL"

 +4        IF $GET(TO)=""

               SET TO="zzzzzzzz"

 +5        SET FLDS="[BAR AGE PRNT]"

 +6        QUIT

 +7       ; *********************************************************************

 +8       ;

FAC       ;

 +1       ; Single Facility print

 +2        SET BY="[BAR AGE FAC SRT]"

 +3        KILL DIC

 +4        SET DIC("A")="Select Facility or press <RETURN> for all Facilities: "

 +5        SET DIC="90052.05"

 +6        SET DIC(0)="AEMQZ"

 +7        DO ^DIC

 +8        IF ($DATA(DUOUT))!($DATA(DTOUT))

               SET BAR("QFLG")=1

 +9        IF Y<0

               QUIT

 +10       SET BAR("CNAME")=Y(0,0)

 +11       SET FR=BAR("CNAME")

 +12       SET TO=BAR("CNAME")

 +13       QUIT

 +14      ; *********************************************************************

 +15      ;

INS       ;

 +1       ;Single Insurer print

 +2        SET BY="[BAR AGE SRT]"

 +3        KILL DIC

 +4        SET DIC("A")="Select Insurer or press <RETURN> for all Insurers: "

 +5        SET DIC="90050.02"

 +6        SET DIC(0)="AEMQZ"

 +7        SET DIC("S")="I $P(^(0),U)[""AUT"",$P(^(0),U,10)=$$VALI^XBDIQ1(200,DUZ,29)"

 +8        DO ^DIC

 +9        IF ($DATA(DUOUT))!($DATA(DTOUT))

               SET BAR("QFLG")=1

 +10       IF Y<0

               QUIT

 +11       SET BAR("CNAME")=Y(0,0)

 +12       SET FR=BAR("CNAME")

 +13       SET TO=BAR("CNAME")

 +14       QUIT

 +15      ; *********************************************************************

 +16      ;

CLIN      ;

 +1       ; Single Clinic print

 +2        SET BY="[BAR AGE CLIN SRT]"

 +3        KILL DIC

 +4        SET DIC("A")="Select Clinic or press <RETURN> for all Clinics: "

 +5        SET DIC="40.7"

 +6        SET DIC(0)="AEMQZ"

 +7        DO ^DIC

 +8        IF ($DATA(DUOUT))!($DATA(DTOUT))

               SET BAR("QFLG")=1

 +9        IF Y<0

               QUIT

 +10       SET BAR("CNAME")=Y(0,0)

 +11       SET FR=BAR("CNAME")

 +12       SET TO=BAR("CNAME")

 +13       QUIT

 +14      ; *********************************************************************

 +15      ;

PAT       ;

 +1       ; Single Patient print

 +2        SET BY="[BAR AGE PAT SRT]"

 +3        KILL DIC

 +4       ; use dfn in specifying patient (block of lines)

 +5        SET DIC("A")="Select Patient or press <RETURN> for all Patients: "

 +6        SET DIC="^AUPNPAT("

 +7        SET DIC(0)="AEQMZI"

 +8        DO ^DIC

 +9        IF ($DATA(DUOUT))!($DATA(DTOUT))

               SET BAR("QFLG")=1

 +10       IF Y<0

               QUIT

 +11       SET DFN=+Y

 +12       SET BAR("CNAME")=Y(0,0)

 +13       SET FR=DFN

 +14       SET TO=DFN

 +15      ; 'end' use dfn in specifying patient

 +16       QUIT

 +17      ; *********************************************************************

 +18      ;

XBLM      ;

 +1        SET Y=$$DIR^XBDIR("S^P:PRINT Output;B:BROWSE Output on Screen","Do you wish to ","P","","","",1)

 +2        KILL DA

 +3        IF $DATA(DIRUT)

               QUIT

 +4        IF Y'="B"

               QUIT

 +5        SET BARBRZ=1

 +6        SET XBFLD("BROWSE")=1

 +7        DO VIEWD^XBLM("EN1^DIP")

 +8        DO FULL^VALM1

 +9        WRITE $$EN^BARVDF("IOF")

 +10      ;clears out all list man stuff

           DO CLEAR^VALM1

 +11       KILL XQORNEST,VALMKEY,VALM,VALMAR,VALMBCK,VALMBG,VALMCAP,VALMCNT,VALMOFF

 +12       KILL VALMCON,VALMDN,VALMEVL,VALMIOXY,VALMKEY,VALMLFT,VALMLST,VALMMENU

 +13       KILL VALMSGR,VALMUP,VALMWD,VALMY,XQORS,XQORSPEW,VALMCOFF

XBLME     ;

 +1        QUIT

BARRAGE.m