Routine: BARAWOR

BARAWOR ; IHS/SD/LSL - ADJUSTMENT AND REFUND REPORT RPT

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

 ; NEW ROUTINE BAR*1.8*10

 ; JULY 2013 P.OTT ADDED NEW INS TYPES

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

START ; EP

 ; Collections report using FM print

S ;

 N DIR

 S DIR(0)="S^D:DETAIL;S:SUMMARY"

 S DIR("A")="Select Report Type"

 D ^DIR

 S BARRDET=Y

 K DIR

 ;S DIR(0)="S^R:MEDICARE;D:MEDICAID;P:PRIVATE INS;H:HMO;M:MEDICARE SUPPL;W:WORKMEN'S COMP;C:CHAMPUS;F:FRATERNAL ORG;N:NON-INDIAN (NON-BEN);I:INDIAN (BENEFICIARY);K:SCHIP;T:TPL;MD:MEDICARE PART D;MH:MEDICARE HMO;A:ALL"

 S DIR("A")="Select Type of Insurer"

 S DIR(0)="SO^R:MEDICARE"

 S DIR(0)=DIR(0)_";D:MEDICAID"

 S DIR(0)=DIR(0)_";P:PRIVATE INSURANCE"

 S DIR(0)=DIR(0)_";H:HMO"

 S DIR(0)=DIR(0)_";M:MEDICARE SUPPL"

 S DIR(0)=DIR(0)_";W:WORKMEN'S COMP"

 S DIR(0)=DIR(0)_";C:CHAMPUS"

 S DIR(0)=DIR(0)_";F:FRATERNAL ORG"

 S DIR(0)=DIR(0)_";N:NON-BENEFICIARY PATIENTS"

 S DIR(0)=DIR(0)_";I:BENEFICIARY PATIENTS"

 S DIR(0)=DIR(0)_";T:TPL"

 S DIR(0)=DIR(0)_";MD:MEDICARE PART D"

 S DIR(0)=DIR(0)_";MH:MEDICARE HMO"

 ;S DIR(0)=DIR(0)_";FPL:MEDICAID" ;FPL 133 PERCENT

 S DIR(0)=DIR(0)_";K:CHIP"

 S DIR(0)=DIR(0)_";V:VETERANS ADMINISTRATION"

 S DIR(0)=DIR(0)_";A:ALL"

 S DIR("A")="Select TYPE of BILLING ENTITY to Display"

 S DIR("?")="Enter TYPE of BILLING ENTITY to display, or press <return> for ALL"

 ; S BARY("TYP")=U_Y_U

 ;S BARY("TYP","NM")=Y(0)

 D ^DIR

 K DIR

 I Y<0!($D(DTOUT))!($D(DUOUT)) Q

 S BAR("RPTYPE")=Y

 D DATE

 G:$D(BAREFLG) END

 D DIPVAR

 D PRINT

 D EOP^BARUTL(1)

END ;

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

DATE ; EP

 ; Select Date Range - Transaction date/time

 K BAREFLG

W !

 S BAR("BDOS")=$$DATE^BARDUTL(1)

 I Y<0 S BAREFLG=1 Q

 S BAR("XBDOS")=$$MDT^BARDUTL(BAR("BDOS"))

 S BAR("EDOS")=$$DATE^BARDUTL(2)

 I Y<0 S BAREFLG=1 Q

 S BAR("XEDOS")=$$MDT^BARDUTL(BAR("EDOS"))

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

PRINT ;

 ; Print

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

 S DIC="90050.03"

 S L=0

 I BAR("RPTYPE")="P" S FR=BAR("BDOS")_",,PRIVATE,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,PRIVATE,,AUTO WRITE-OFF 2007,"

 I BAR("RPTYPE")="R" S FR=BAR("BDOS")_",,MEDICARE FI,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,MEDICARE FI,,AUTO WRITE-OFF 2007,"

 I BAR("RPTYPE")="D" S FR=BAR("BDOS")_",,MEDICAID FI,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,MEDICAID FI,,AUTO WRITE-OFF 2007,"

 I BAR("RPTYPE")="H" S FR=BAR("BDOS")_",,HMO,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,HMO,,,"

 I BAR("RPTYPE")="M" S FR=BAR("BDOS")_",,MEDICARE SUPPL,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,MEDICARE SUPPL,,AUTO WRITE-OFF 2007,"

 I BAR("RPTYPE")="W" S FR=BAR("BDOS")_",,WORKMEN'S COMP,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,WORKMEN'S COMP,,AUTO WRITE-OFF 2007,"

 I BAR("RPTYPE")="C" S FR=BAR("BDOS")_",,CHAMPUS,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,CHAMPUS,,AUTO WRITE-OFF 2007,"

 I BAR("RPTYPE")="F" S FR=BAR("BDOS")_",,FRATERNAL ORG,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,FRATERNAL ORG,,AUTO WRITE-OFF 2007,"

 I BAR("RPTYPE")="N" S FR=BAR("BDOS")_",,NON-BEN (NON-INDIAN),,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,NON-BEN (NON-INDIAN),,AUTO WRITE-OFF 2007,"

 I BAR("RPTYPE")="I" S FR=BAR("BDOS")_",,INDIAN PATIENT,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,INDIAN PATIENT,,AUTO WRITE-OFF 2007,"

 I BAR("RPTYPE")="K" S FR=BAR("BDOS")_",,CHIP (KIDSCARE),,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,CHIP (KIDSCARE),,AUTO WRITE-OFF 2007,"

 I BAR("RPTYPE")="T" S FR=BAR("BDOS")_",,3P LIABILITY,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,3P LIABILITY,,AUTO WRITE-OFF 2007,"

 I BAR("RPTYPE")="MD" S FR=BAR("BDOS")_",,MCR PART D,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,MCR PART D,,AUTO WRITE-OFF 2007,"

 I BAR("RPTYPE")="MH" S FR=BAR("BDOS")_",,MEDICARE HMO,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,MEDICARE HMO,,AUTO WRITE-OFF 2007,"

 I BAR("RPTYPE")="V" S FR=BAR("BDOS")_",,VA,,WRITE-OFF 2000,",TO=BAR("EDOS")_",,VA,,WRITE-OFF 2007,"

 I BAR("RPTYPE")="A" S FR=BAR("BDOS")_",,,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,,,AUTO WRITE-OFF 2007,"

 ;S FR=BAR("BDOS")_",,,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,,,AUTO WRITE-OFF 2007,"

 D EN1^DIP

DSP ; EP for VALM

 D ^%ZISC,HOME^%ZIS

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

DIPVAR ;

 ; Set up DIP variables and Header routine

 Q:$D(BAREFLG)

 S BY="@'.01,@101,6:1.08;""INSURER TYPE: "",102,+103;""REASON: "";L20,+6;""+"";S1;C1;"""

 D:BARRDET="D" DETAIL

 D:BARRDET="S" SUMMARY

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

DETAIL ;

 ;S DHD="[BAR ADAL HDR"

 S DHD="AUTOMATIC WRITE OFF REPORT FOR "

 S FLDS="NUMDATE4(#12);""TRANSACTION DATE"",!4;L18,4:102;""SERVICE DATE"",&3.7;R10;C65;D2;""ADJUSTMENT"""  ;Y2000

SUMMARY ;

 S FLDS="6!,&3.7;R10;C45;D2;""ADJUSTMENT"",&3.619;R9;D2""REFUND"",&3.5;R10;D2;""CREDIT/DEBIT"""  ;Print A/R ACCOUNT,ADJ, REF, CREDIT-DEBIT

 ;S DHD="[BAR ADALS HDR]"

BARAWOR   ; IHS/SD/LSL - ADJUSTMENT AND REFUND REPORT RPT

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

 +2       ; NEW ROUTINE BAR*1.8*10

 +3       ; JULY 2013 P.OTT ADDED NEW INS TYPES

 +4       ;************************************************************

START     ; EP

 +1       ; Collections report using FM print

 +2       ;

S         ;

 +1        NEW DIR

 +2        SET DIR(0)="S^D:DETAIL;S:SUMMARY"

 +3        SET DIR("A")="Select Report Type"

 +4        DO ^DIR

 +5        SET BARRDET=Y

 +6        KILL DIR

 +7       ;S DIR(0)="S^R:MEDICARE;D:MEDICAID;P:PRIVATE INS;H:HMO;M:MEDICARE SUPPL;W:WORKMEN'S COMP;C:CHAMPUS;F:FRATERNAL ORG;N:NON-INDIAN (NON-BEN);I:INDIAN (BENEFICIARY);K:SCHIP;T:TPL;MD:MEDICARE PART D;MH:MEDICARE HMO;A:ALL"

 +8        SET DIR("A")="Select Type of Insurer"

 +9        SET DIR(0)="SO^R:MEDICARE"

 +10       SET DIR(0)=DIR(0)_";D:MEDICAID"

 +11       SET DIR(0)=DIR(0)_";P:PRIVATE INSURANCE"

 +12       SET DIR(0)=DIR(0)_";H:HMO"

 +13       SET DIR(0)=DIR(0)_";M:MEDICARE SUPPL"

 +14       SET DIR(0)=DIR(0)_";W:WORKMEN'S COMP"

 +15       SET DIR(0)=DIR(0)_";C:CHAMPUS"

 +16       SET DIR(0)=DIR(0)_";F:FRATERNAL ORG"

 +17       SET DIR(0)=DIR(0)_";N:NON-BENEFICIARY PATIENTS"

 +18       SET DIR(0)=DIR(0)_";I:BENEFICIARY PATIENTS"

 +19       SET DIR(0)=DIR(0)_";T:TPL"

 +20       SET DIR(0)=DIR(0)_";MD:MEDICARE PART D"

 +21       SET DIR(0)=DIR(0)_";MH:MEDICARE HMO"

 +22      ;S DIR(0)=DIR(0)_";FPL:MEDICAID" ;FPL 133 PERCENT

 +23       SET DIR(0)=DIR(0)_";K:CHIP"

 +24       SET DIR(0)=DIR(0)_";V:VETERANS ADMINISTRATION"

 +25       SET DIR(0)=DIR(0)_";A:ALL"

 +26       SET DIR("A")="Select TYPE of BILLING ENTITY to Display"

 +27       SET DIR("?")="Enter TYPE of BILLING ENTITY to display, or press <return> for ALL"

 +28      ; S BARY("TYP")=U_Y_U

 +29      ;S BARY("TYP","NM")=Y(0)

 +30       DO ^DIR

 +31       KILL DIR

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

               QUIT

 +33       SET BAR("RPTYPE")=Y

 +34       DO DATE

 +35       IF $DATA(BAREFLG)

               GOTO END

 +36       DO DIPVAR

 +37       DO PRINT

 +38       DO EOP^BARUTL(1)

 +39      ;

END       ;

 +1        QUIT

 +2       ; *********************************************************************

 +3       ;

DATE      ; EP

 +1       ; Select Date Range - Transaction date/time

 +2        KILL BAREFLG

 +3        WRITE !

 +4        SET BAR("BDOS")=$$DATE^BARDUTL(1)

 +5        IF Y<0

               SET BAREFLG=1

               QUIT

 +6        SET BAR("XBDOS")=$$MDT^BARDUTL(BAR("BDOS"))

 +7        SET BAR("EDOS")=$$DATE^BARDUTL(2)

 +8        IF Y<0

               SET BAREFLG=1

               QUIT

 +9        SET BAR("XEDOS")=$$MDT^BARDUTL(BAR("EDOS"))

 +10       QUIT

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

 +12      ;

PRINT     ;

 +1       ; Print

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

 +3        SET DIC="90050.03"

 +4        SET L=0

 +5        IF BAR("RPTYPE")="P"

               SET FR=BAR("BDOS")_",,PRIVATE,,AUTO WRITE-OFF 2000,"

               SET TO=BAR("EDOS")_",,PRIVATE,,AUTO WRITE-OFF 2007,"

 +6        IF BAR("RPTYPE")="R"

               SET FR=BAR("BDOS")_",,MEDICARE FI,,AUTO WRITE-OFF 2000,"

               SET TO=BAR("EDOS")_",,MEDICARE FI,,AUTO WRITE-OFF 2007,"

 +7        IF BAR("RPTYPE")="D"

               SET FR=BAR("BDOS")_",,MEDICAID FI,,AUTO WRITE-OFF 2000,"

               SET TO=BAR("EDOS")_",,MEDICAID FI,,AUTO WRITE-OFF 2007,"

 +8        IF BAR("RPTYPE")="H"

               SET FR=BAR("BDOS")_",,HMO,,AUTO WRITE-OFF 2000,"

               SET TO=BAR("EDOS")_",,HMO,,,"

 +9        IF BAR("RPTYPE")="M"

               SET FR=BAR("BDOS")_",,MEDICARE SUPPL,,AUTO WRITE-OFF 2000,"

               SET TO=BAR("EDOS")_",,MEDICARE SUPPL,,AUTO WRITE-OFF 2007,"

 +10       IF BAR("RPTYPE")="W"

               SET FR=BAR("BDOS")_",,WORKMEN'S COMP,,AUTO WRITE-OFF 2000,"

               SET TO=BAR("EDOS")_",,WORKMEN'S COMP,,AUTO WRITE-OFF 2007,"

 +11       IF BAR("RPTYPE")="C"

               SET FR=BAR("BDOS")_",,CHAMPUS,,AUTO WRITE-OFF 2000,"

               SET TO=BAR("EDOS")_",,CHAMPUS,,AUTO WRITE-OFF 2007,"

 +12       IF BAR("RPTYPE")="F"

               SET FR=BAR("BDOS")_",,FRATERNAL ORG,,AUTO WRITE-OFF 2000,"

               SET TO=BAR("EDOS")_",,FRATERNAL ORG,,AUTO WRITE-OFF 2007,"

 +13       IF BAR("RPTYPE")="N"

               SET FR=BAR("BDOS")_",,NON-BEN (NON-INDIAN),,AUTO WRITE-OFF 2000,"

               SET TO=BAR("EDOS")_",,NON-BEN (NON-INDIAN),,AUTO WRITE-OFF 2007,"

 +14       IF BAR("RPTYPE")="I"

               SET FR=BAR("BDOS")_",,INDIAN PATIENT,,AUTO WRITE-OFF 2000,"

               SET TO=BAR("EDOS")_",,INDIAN PATIENT,,AUTO WRITE-OFF 2007,"

 +15       IF BAR("RPTYPE")="K"

               SET FR=BAR("BDOS")_",,CHIP (KIDSCARE),,AUTO WRITE-OFF 2000,"

               SET TO=BAR("EDOS")_",,CHIP (KIDSCARE),,AUTO WRITE-OFF 2007,"

 +16       IF BAR("RPTYPE")="T"

               SET FR=BAR("BDOS")_",,3P LIABILITY,,AUTO WRITE-OFF 2000,"

               SET TO=BAR("EDOS")_",,3P LIABILITY,,AUTO WRITE-OFF 2007,"

 +17       IF BAR("RPTYPE")="MD"

               SET FR=BAR("BDOS")_",,MCR PART D,,AUTO WRITE-OFF 2000,"

               SET TO=BAR("EDOS")_",,MCR PART D,,AUTO WRITE-OFF 2007,"

 +18       IF BAR("RPTYPE")="MH"

               SET FR=BAR("BDOS")_",,MEDICARE HMO,,AUTO WRITE-OFF 2000,"

               SET TO=BAR("EDOS")_",,MEDICARE HMO,,AUTO WRITE-OFF 2007,"

 +19       IF BAR("RPTYPE")="V"

               SET FR=BAR("BDOS")_",,VA,,WRITE-OFF 2000,"

               SET TO=BAR("EDOS")_",,VA,,WRITE-OFF 2007,"

 +20       IF BAR("RPTYPE")="A"

               SET FR=BAR("BDOS")_",,,,AUTO WRITE-OFF 2000,"

               SET TO=BAR("EDOS")_",,,,AUTO WRITE-OFF 2007,"

 +21      ;S FR=BAR("BDOS")_",,,,AUTO WRITE-OFF 2000,",TO=BAR("EDOS")_",,,,AUTO WRITE-OFF 2007,"

 +22       DO EN1^DIP

 +23      ;

DSP       ; EP for VALM

 +1        DO ^%ZISC

           DO HOME^%ZIS

 +2        QUIT

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

 +4       ;

DIPVAR    ;

 +1       ; Set up DIP variables and Header routine

 +2        IF $DATA(BAREFLG)

               QUIT

 +3        SET BY="@'.01,@101,6:1.08;""INSURER TYPE: "",102,+103;""REASON: "";L20,+6;""+"";S1;C1;"""

 +4        IF BARRDET="D"

               DO DETAIL

 +5        IF BARRDET="S"

               DO SUMMARY

 +6        QUIT

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

 +8       ;

DETAIL    ;

 +1       ;S DHD="[BAR ADAL HDR"

 +2        SET DHD="AUTOMATIC WRITE OFF REPORT FOR "

 +3       ;Y2000

           SET FLDS="NUMDATE4(#12);""TRANSACTION DATE"",!4;L18,4:102;""SERVICE DATE"",&3.7;R10;C65;D2;""ADJUSTMENT"""

 +4        QUIT

 +5       ;

SUMMARY   ;

 +1       ;Print A/R ACCOUNT,ADJ, REF, CREDIT-DEBIT

           SET FLDS="6!,&3.7;R10;C45;D2;""ADJUSTMENT"",&3.619;R9;D2""REFUND"",&3.5;R10;D2;""CREDIT/DEBIT"""

 +2       ;S DHD="[BAR ADALS HDR]"

 +3        QUIT

BARAWOR.m