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
Q
; *********************************************************************
;
PRINT ;
; Print
K DIC
;
S ;
S DIC="90050.01"
S L=0
;
PRINT2 ; EP
S HDR="@"
D EN1^DIP
D ^%ZISC,HOME^%ZIS
Q
; *********************************************************************
;
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]"
Q
; *********************************************************************
;
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")
Q
; *********************************************************************
;
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")
Q
; *********************************************************************
;
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")
Q
; *********************************************************************
;
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
Q
; *********************************************************************
;
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 ;
Q
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
