BARRSL2.m

BARRSL2 ; IHS/SD/LSL - Selective Report Parameters-PART 3 ;

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

 ;

 ; IHS/SD/PKD - 5/10/10 - V1.8 patch 19

 ; 		ADDED TAG CANC PTYP for CANCELLATION REPORT

 ; IHS/ASDS/LSL - 04/10/02 - Routine created

 ;

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

 ;     Add DSCHSVC line tag to sort reports by Discharge Service

 ; MAR 2013 P.OTTIS ADDED NEW VA billing

 Q

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

 ;

ARACCT ; EP

 ; Select A/R Accounts to sort by

 K BARY("ARACCT")

 S DIC="^BARAC(DUZ(2),"

 S DIC(0)="AEMQ"

 S DIC("A")="Select A/R Account: ALL// "

 F  D  Q:+Y<0

 . I $D(BARY("ARACCT")) S DIC("A")="Select Another A/R Account: "

 . D ^DIC

 . Q:+Y<0

 . S BARY("ARACCT",+Y)=""

 I '$D(BARY("ARACCT")) D

 . I $D(DUOUT) K BARY("SORT") Q

 . W "ALL"

 K DIC

 Q

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

 ;

DSCHSVC ;EP

 ; Select Discharge Service to sort by (really comes from the

 ; FACILITY TREATING SPECIALTY File ^DIC(45.7)

 K BARY("DSCH")

 S DIC="^DIC(45.7,"

 S DIC(0)="AEMQ"

 S DIC("A")="Select Discharge Service: ALL// "

 F  D  Q:+Y<0

 . I $D(BARY("DSCH")) S DIC("A")="Select Another Discharge Service: "

 . D ^DIC

 . Q:+Y<0

 . S BARY("DSCH",+Y)=""

 I '$D(BARY("DSCH")) D

 . I $D(DUOUT) K BARY("SORT") Q

 . W "ALL"

 K DIC

 Q

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

 ;

CONVERT(BARA) ;EP

 ; Convert Allowance Categories from numbers to letters

 ; Where BARA is the number needing conversion

 I '$D(BARA) Q "O"

 S BARTMP="O"

 S:BARA=1 BARTMP="R"

 S:BARA=2 BARTMP="D"

 S:BARA=3 BARTMP="P"

 S:BARA=4 BARTMP="V"  ;P.OTT

 S:BARA=5 BARTMP="O"  ;

 S BARA=BARTMP

 K BARTMP

 Q BARA

 ;  START BAR*1.8*19 PKD  5/7/10 

 ;       

APPR  ;EP Approving Official

CANC  ;EP 3PB Cancelling Official 

 K BARY("CANC"),BARY("APPR")

 W !

 S DIC="^VA(200,"

 S DIC(0)="QEAM"

 D ^DIC

 I +Y>0 D

 . I BAR("OPT")="CXL" S BARY("CANC")=+Y Q

 . I BAR("OPT")="PAY" S BARY("APPR")=+Y,BARY("APPR","NM")=$P(Y,U,2)

 Q

 ;

 ;  PKD BAR*1.8*19  5/7/10 

PTYP ;EP  Eligibility Question

 K DIR

 S DIR(0)="SO^1:INDIAN BENEFICIARY PATIENTS;2:NON-BENEFICIARY PATIENTS"

 S DIR("A")="Select the PATIENT ELIGIBILITY STATUS"

 S DIR("?")="Selection of an Eligibility Status will restrict the report to only those visits in which the patient is of the type designated."

 D ^DIR

 K DIR

 Q:$D(DIRUT)

 S BARY("PTYP")=Y

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

 Q

 ;

TDN  ; Multiple TDN's can be entered IHS/BAR/PKD 1.8*19 6/1/10

 ; 

 I BAR("OPT")="TDN" K BARY("DT")  ; Date Range OR TDN list

 K BARY("TDN") N BARTDN

 S DIC="^BARCOL(DUZ(2),"

 S DIC(0)="AEQ"

 S DIC("A")="Select TDN**: "

 F  D  Q:+Y<0!(X="^")

 . S D="E"  ; Index to search

 . I $D(BARY("TDN")) S DIC("A")="Select Another TDN: "

 . D IX^DIC

 . Q:+Y<0

 . S BARTDN=X  ; X is TDN

 . S BARY("TDN",BARTDN)=""

 . D DISP^BARRSEL

 K DIC

 Q

CLNC  ; Clinic - One or All

 K BARY("CLNC")

 S DIC="^DIC(40.7,"

 S DIC(0)="AEMQ"

 S DIC("A")="Select Clinic: ALL// "

 D ^DIC

 Q:+Y<0

 S BARY("CLNC",+Y)="",BARY("CLNC","NM")=$P(Y,U,2)

 K DIC

 Q

ADJTY  ; Adjustment Type One or All

 W !,"IN PROCESS  ******************************************",*7

 Q

BARRSL2   ; IHS/SD/LSL - Selective Report Parameters-PART 3 ;

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

 +2       ;

 +3       ; IHS/SD/PKD - 5/10/10 - V1.8 patch 19

 +4       ; 		ADDED TAG CANC PTYP for CANCELLATION REPORT

 +5       ; IHS/ASDS/LSL - 04/10/02 - Routine created

 +6       ;

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

 +8       ;     Add DSCHSVC line tag to sort reports by Discharge Service

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

 +10       QUIT 

 +11      ; *********************************************************************

 +12      ;

ARACCT    ; EP

 +1       ; Select A/R Accounts to sort by

 +2        KILL BARY("ARACCT")

 +3        SET DIC="^BARAC(DUZ(2),"

 +4        SET DIC(0)="AEMQ"

 +5        SET DIC("A")="Select A/R Account: ALL// "

 +6        FOR 

               Begin DoDot:1

 +7                IF $DATA(BARY("ARACCT"))

                       SET DIC("A")="Select Another A/R Account: "

 +8                DO ^DIC

 +9                IF +Y<0

                       QUIT 

 +10               SET BARY("ARACCT",+Y)=""

               End DoDot:1

               IF +Y<0

                   QUIT 

 +11       IF '$DATA(BARY("ARACCT"))

               Begin DoDot:1

 +12               IF $DATA(DUOUT)

                       KILL BARY("SORT")

                       QUIT 

 +13               WRITE "ALL"

               End DoDot:1

 +14       KILL DIC

 +15       QUIT 

 +16      ; *********************************************************************

 +17      ;

DSCHSVC   ;EP

 +1       ; Select Discharge Service to sort by (really comes from the

 +2       ; FACILITY TREATING SPECIALTY File ^DIC(45.7)

 +3        KILL BARY("DSCH")

 +4        SET DIC="^DIC(45.7,"

 +5        SET DIC(0)="AEMQ"

 +6        SET DIC("A")="Select Discharge Service: ALL// "

 +7        FOR 

               Begin DoDot:1

 +8                IF $DATA(BARY("DSCH"))

                       SET DIC("A")="Select Another Discharge Service: "

 +9                DO ^DIC

 +10               IF +Y<0

                       QUIT 

 +11               SET BARY("DSCH",+Y)=""

               End DoDot:1

               IF +Y<0

                   QUIT 

 +12       IF '$DATA(BARY("DSCH"))

               Begin DoDot:1

 +13               IF $DATA(DUOUT)

                       KILL BARY("SORT")

                       QUIT 

 +14               WRITE "ALL"

               End DoDot:1

 +15       KILL DIC

 +16       QUIT 

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

 +18      ;

CONVERT(BARA) ;EP

 +1       ; Convert Allowance Categories from numbers to letters

 +2       ; Where BARA is the number needing conversion

 +3        IF '$DATA(BARA)

               QUIT "O"

 +4        SET BARTMP="O"

 +5        IF BARA=1

               SET BARTMP="R"

 +6        IF BARA=2

               SET BARTMP="D"

 +7        IF BARA=3

               SET BARTMP="P"

 +8       ;P.OTT

           IF BARA=4

               SET BARTMP="V"

 +9       ;

           IF BARA=5

               SET BARTMP="O"

 +10       SET BARA=BARTMP

 +11       KILL BARTMP

 +12       QUIT BARA

 +13      ;  START BAR*1.8*19 PKD  5/7/10 

 +14      ;       

APPR      ;EP Approving Official

CANC      ;EP 3PB Cancelling Official 

 +1        KILL BARY("CANC"),BARY("APPR")

 +2        WRITE !

 +3        SET DIC="^VA(200,"

 +4        SET DIC(0)="QEAM"

 +5        DO ^DIC

 +6        IF +Y>0

               Begin DoDot:1

 +7                IF BAR("OPT")="CXL"

                       SET BARY("CANC")=+Y

                       QUIT 

 +8                IF BAR("OPT")="PAY"

                       SET BARY("APPR")=+Y

                       SET BARY("APPR","NM")=$PIECE(Y,U,2)

               End DoDot:1

 +9        QUIT 

 +10      ;

 +11      ;  PKD BAR*1.8*19  5/7/10 

PTYP      ;EP  Eligibility Question

 +1        KILL DIR

 +2        SET DIR(0)="SO^1:INDIAN BENEFICIARY PATIENTS;2:NON-BENEFICIARY PATIENTS"

 +3        SET DIR("A")="Select the PATIENT ELIGIBILITY STATUS"

 +4        SET DIR("?")="Selection of an Eligibility Status will restrict the report to only those visits in which the patient is of the type designated."

 +5        DO ^DIR

 +6        KILL DIR

 +7        IF $DATA(DIRUT)

               QUIT 

 +8        SET BARY("PTYP")=Y

 +9        SET BARY("PTYP","NM")=Y(0)

 +10       QUIT 

 +11      ;

TDN       ; Multiple TDN's can be entered IHS/BAR/PKD 1.8*19 6/1/10

 +1       ; 

 +2       ; Date Range OR TDN list

           IF BAR("OPT")="TDN"

               KILL BARY("DT")

 +3        KILL BARY("TDN")

           NEW BARTDN

 +4        SET DIC="^BARCOL(DUZ(2),"

 +5        SET DIC(0)="AEQ"

 +6        SET DIC("A")="Select TDN**: "

 +7        FOR 

               Begin DoDot:1

 +8       ; Index to search

                   SET D="E"

 +9                IF $DATA(BARY("TDN"))

                       SET DIC("A")="Select Another TDN: "

 +10               DO IX^DIC

 +11               IF +Y<0

                       QUIT 

 +12      ; X is TDN

                   SET BARTDN=X

 +13               SET BARY("TDN",BARTDN)=""

 +14               DO DISP^BARRSEL

               End DoDot:1

               IF +Y<0!(X="^")

                   QUIT 

 +15       KILL DIC

 +16       QUIT 

CLNC      ; Clinic - One or All

 +1        KILL BARY("CLNC")

 +2        SET DIC="^DIC(40.7,"

 +3        SET DIC(0)="AEMQ"

 +4        SET DIC("A")="Select Clinic: ALL// "

 +5        DO ^DIC

 +6        IF +Y<0

               QUIT 

 +7        SET BARY("CLNC",+Y)=""

           SET BARY("CLNC","NM")=$PIECE(Y,U,2)

 +8        KILL DIC

 +9        QUIT 

ADJTY     ; Adjustment Type One or All

 +1        WRITE !,"IN PROCESS  ******************************************",*7

 +2        QUIT