BARRASMA.m

BARRASMA ; IHS/SD/LSL - Age Summary Report Questions ;

 ;;1.8;IHS ACCOUNTS RECEIVABLE;**6,23***;OCT 26, 2005

 ;

 ; IHS/ASDS/LSL - 02/27/02 - Routine created

 ;     Called from BARRASM

 ;     ASK^BARRASMA   - Ask all questions and define header array.

 ;     PRINT^BARRASMA - Print report

 ;

 ; IHS/SD/LSL - 02/20/03 - V1.7 Patch 1

 ;     Added DISCHARGE SERVICE sort and report.  Add time run to report

 ;     headers.

 ;

 ; IHS/SD/LSL - 08/01/03 - V1.7 Patch 2

 ;     Add call to ASM^BAREISS to print of summary data

 ;

 ; IHS/SD/LSL - 11/24/03 - V1.7 Patch 4

 ;     Add Visit Location Sort level to accomodate EISS

 ;     Move print logic to BARRASMB.  Routine too large

 ; ; MAR 2013 P.OTTIS ADDED NEW VA billing

 Q

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

 ;

ASK ; EP

 S BARA("LOC")=0

 S BARA("SORT")=0

 D MSG^BARRSEL                      ; Message about BILL/VIS loc

 D LOC^BARRSL1                      ; Ask loc - return BARY("LOC")

 Q:$D(DTOUT)!($D(DUOUT))            ; Q if time or "^" out

 W:'$D(BARY("LOC")) "ALL"

 F  D SORT Q:BARA("SORT")           ; Ask sort criteria-required

 Q:'+$G(BARY("STCR"))               ; No sort criteria specified - Q

 I BARY("STCR")=1 D  Q

 . W !

 . D ARACCT^BARRSL2                 ; Ask A/R Account-return BARY(

 I BARY("STCR")=2 D  Q

 . W !

 . D CLIN^BARRSEL                   ; Ask clinic-return BARY("CLIN")

 I BARY("STCR")=3 D  Q

 . W !

 . D VTYP^BARRSEL                   ; Ask Vis type-return BARY("VTYP")

 I BARY("STCR")=4 D  Q

 . W !

 . D DSCHSVC^BARRSL2                ; Ask Discharge Svc-return BARY("DSCH")

 I BARY("STCR")=5 D

 . D ALL^BARRSL1                    ; Ask allow cat-return BARY("ALL")

 . Q:$D(DTOUT)!($D(DUOUT))

 . W:'$D(BARY("ALL")) "ALL"         ; If not select category, then ALL

 I BARY("STCR")=6 D

 . D TYP^BARRSL1                    ; Ask billing entity

 . Q:$D(DTOUT)!($D(DUOUT))

 . W:('$D(BARY("TYP"))&'$D(BARY("ACCT"))&'$D(BARY("PAT"))) "ALL"

 I BARY("STCR")=7 D

 . D ITYP^BARRSL1                    ; Ask ins type-return BARY("ITYP")

 . Q:$D(DTOUT)!($D(DUOUT))

 . W:'$D(BARY("ITYP")) "ALL"        ; If not select ins type,ALL

 ; Ask rpt type (only if sort by allow cat/bill ent-return BARY("RTYP")

 Q:$D(DTOUT)!($D(DUOUT))

 D RTYP                             ; Ask report type

 ;I $D(BARY("ALL")) S BARY("ALL")=$S(BARY("ALL")=1:"R",BARY("ALL")=2:"D",BARY("ALL")=3:"P",BARY("ALL")=4:"K",1:"O")

 I $D(BARY("ALL")) S BARY("ALL")=$S(BARY("ALL")=1:"R",BARY("ALL")=2:"D",BARY("ALL")=3:"P",BARY("ALL")=4:"V",1:"O") ;P.OTT

 Q

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

 ;

SORT ;

 ; Ask how report should be sorted;  clinic, visit, allowance category,

 ; or billing entity

 K DIR,BARY("STCR")

 S DIR(0)="S^1:A/R ACCOUNT"

 S DIR(0)=DIR(0)_";2:CLINIC TYPE"

 S DIR(0)=DIR(0)_";3:VISIT TYPE"

 S DIR(0)=DIR(0)_";4:DISCHARGE SERVICE"

 S DIR(0)=DIR(0)_";5:ALLOWANCE CATEGORY"

 S DIR(0)=DIR(0)_";6:BILLING ENTITY"

 S DIR(0)=DIR(0)_";7:INSURER TYPE"

 S DIR("A")="Select criteria for sorting"

 S DIR("?")="This is a required response.  Enter ^ to exit"

 D ^DIR

 K DIR

 S:($D(DTOUT)!$D(DUOUT)) BARA("SORT")=1

 Q:Y<1

 S BARA("SORT")=1                   ; The question was answered

 S BARY("STCR")=+Y

 S BARY("STCR","NM")=Y(0)

 ; Following lines needed for BARRCHK to work

 S:BARY("STCR")=2 BARY("SORT")="C"

 S:BARY("STCR")=3 BARY("SORT")="V"

 Q

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

 ;

RTYP ;

 ; Ask report type if user choose to sort by billing entity or

 ; allowance category

 S DIR(0)="S^1:Summarize by ALLOW CAT/BILL ENTITY/INS TYPE"

 S DIR(0)=DIR(0)_";2:Summarize by PAYER w/in ALLOW CAT/BILL ENTITY/INS TYPE"

 S DIR(0)=DIR(0)_";3:Summarize by BILL w/in PAYER w/in ALLOW CAT/BILL ENTITY/INS TYPE"

 S DIR("A")="Select REPORT TYPE"

 S DIR("B")=1

 S DIR("?",1)="Enter the selection that best describes the summary information desired"

 S DIR("?")="Enter ^ to exit"

 D ^DIR

 K DIR

 Q:Y<1

 S BARY("RTYP")=+Y

 S BARY("RTYP","NM")=Y(0)

 Q

BARRASMA  ; IHS/SD/LSL - Age Summary Report Questions ;

 +1       ;;1.8;IHS ACCOUNTS RECEIVABLE;**6,23***;OCT 26, 2005

 +2       ;

 +3       ; IHS/ASDS/LSL - 02/27/02 - Routine created

 +4       ;     Called from BARRASM

 +5       ;     ASK^BARRASMA   - Ask all questions and define header array.

 +6       ;     PRINT^BARRASMA - Print report

 +7       ;

 +8       ; IHS/SD/LSL - 02/20/03 - V1.7 Patch 1

 +9       ;     Added DISCHARGE SERVICE sort and report.  Add time run to report

 +10      ;     headers.

 +11      ;

 +12      ; IHS/SD/LSL - 08/01/03 - V1.7 Patch 2

 +13      ;     Add call to ASM^BAREISS to print of summary data

 +14      ;

 +15      ; IHS/SD/LSL - 11/24/03 - V1.7 Patch 4

 +16      ;     Add Visit Location Sort level to accomodate EISS

 +17      ;     Move print logic to BARRASMB.  Routine too large

 +18      ; ; MAR 2013 P.OTTIS ADDED NEW VA billing

 +19       QUIT 

 +20      ; *********************************************************************

 +21      ;

ASK       ; EP

 +1        SET BARA("LOC")=0

 +2        SET BARA("SORT")=0

 +3       ; Message about BILL/VIS loc

           DO MSG^BARRSEL

 +4       ; Ask loc - return BARY("LOC")

           DO LOC^BARRSL1

 +5       ; Q if time or "^" out

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

               QUIT 

 +6        IF '$DATA(BARY("LOC"))

               WRITE "ALL"

 +7       ; Ask sort criteria-required

           FOR 

               DO SORT

               IF BARA("SORT")

                   QUIT 

 +8       ; No sort criteria specified - Q

           IF '+$GET(BARY("STCR"))

               QUIT 

 +9        IF BARY("STCR")=1

               Begin DoDot:1

 +10               WRITE !

 +11      ; Ask A/R Account-return BARY(

                   DO ARACCT^BARRSL2

               End DoDot:1

               QUIT 

 +12       IF BARY("STCR")=2

               Begin DoDot:1

 +13               WRITE !

 +14      ; Ask clinic-return BARY("CLIN")

                   DO CLIN^BARRSEL

               End DoDot:1

               QUIT 

 +15       IF BARY("STCR")=3

               Begin DoDot:1

 +16               WRITE !

 +17      ; Ask Vis type-return BARY("VTYP")

                   DO VTYP^BARRSEL

               End DoDot:1

               QUIT 

 +18       IF BARY("STCR")=4

               Begin DoDot:1

 +19               WRITE !

 +20      ; Ask Discharge Svc-return BARY("DSCH")

                   DO DSCHSVC^BARRSL2

               End DoDot:1

               QUIT 

 +21       IF BARY("STCR")=5

               Begin DoDot:1

 +22      ; Ask allow cat-return BARY("ALL")

                   DO ALL^BARRSL1

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

                       QUIT 

 +24      ; If not select category, then ALL

                   IF '$DATA(BARY("ALL"))

                       WRITE "ALL"

               End DoDot:1

 +25       IF BARY("STCR")=6

               Begin DoDot:1

 +26      ; Ask billing entity

                   DO TYP^BARRSL1

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

                       QUIT 

 +28               IF ('$DATA(BARY("TYP"))&'$DATA(BARY("ACCT"))&'$DATA(BARY("PAT")))

                       WRITE "ALL"

               End DoDot:1

 +29       IF BARY("STCR")=7

               Begin DoDot:1

 +30      ; Ask ins type-return BARY("ITYP")

                   DO ITYP^BARRSL1

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

                       QUIT 

 +32      ; If not select ins type,ALL

                   IF '$DATA(BARY("ITYP"))

                       WRITE "ALL"

               End DoDot:1

 +33      ; Ask rpt type (only if sort by allow cat/bill ent-return BARY("RTYP")

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

               QUIT 

 +35      ; Ask report type

           DO RTYP

 +36      ;I $D(BARY("ALL")) S BARY("ALL")=$S(BARY("ALL")=1:"R",BARY("ALL")=2:"D",BARY("ALL")=3:"P",BARY("ALL")=4:"K",1:"O")

 +37      ;P.OTT

           IF $DATA(BARY("ALL"))

               SET BARY("ALL")=$SELECT(BARY("ALL")=1:"R",BARY("ALL")=2:"D",BARY("ALL")=3:"P",BARY("ALL")=4:"V",1:"O")

 +38       QUIT 

 +39      ; *********************************************************************

 +40      ;

SORT      ;

 +1       ; Ask how report should be sorted;  clinic, visit, allowance category,

 +2       ; or billing entity

 +3        KILL DIR,BARY("STCR")

 +4        SET DIR(0)="S^1:A/R ACCOUNT"

 +5        SET DIR(0)=DIR(0)_";2:CLINIC TYPE"

 +6        SET DIR(0)=DIR(0)_";3:VISIT TYPE"

 +7        SET DIR(0)=DIR(0)_";4:DISCHARGE SERVICE"

 +8        SET DIR(0)=DIR(0)_";5:ALLOWANCE CATEGORY"

 +9        SET DIR(0)=DIR(0)_";6:BILLING ENTITY"

 +10       SET DIR(0)=DIR(0)_";7:INSURER TYPE"

 +11       SET DIR("A")="Select criteria for sorting"

 +12       SET DIR("?")="This is a required response.  Enter ^ to exit"

 +13       DO ^DIR

 +14       KILL DIR

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

               SET BARA("SORT")=1

 +16       IF Y<1

               QUIT 

 +17      ; The question was answered

           SET BARA("SORT")=1

 +18       SET BARY("STCR")=+Y

 +19       SET BARY("STCR","NM")=Y(0)

 +20      ; Following lines needed for BARRCHK to work

 +21       IF BARY("STCR")=2

               SET BARY("SORT")="C"

 +22       IF BARY("STCR")=3

               SET BARY("SORT")="V"

 +23       QUIT 

 +24      ; *********************************************************************

 +25      ;

RTYP      ;

 +1       ; Ask report type if user choose to sort by billing entity or

 +2       ; allowance category

 +3        SET DIR(0)="S^1:Summarize by ALLOW CAT/BILL ENTITY/INS TYPE"

 +4        SET DIR(0)=DIR(0)_";2:Summarize by PAYER w/in ALLOW CAT/BILL ENTITY/INS TYPE"

 +5        SET DIR(0)=DIR(0)_";3:Summarize by BILL w/in PAYER w/in ALLOW CAT/BILL ENTITY/INS TYPE"

 +6        SET DIR("A")="Select REPORT TYPE"

 +7        SET DIR("B")=1

 +8        SET DIR("?",1)="Enter the selection that best describes the summary information desired"

 +9        SET DIR("?")="Enter ^ to exit"

 +10       DO ^DIR

 +11       KILL DIR

 +12       IF Y<1

               QUIT 

 +13       SET BARY("RTYP")=+Y

 +14       SET BARY("RTYP","NM")=Y(0)

 +15       QUIT