BARRADAL.m

BARRADAL ; IHS/SD/LSL - ADVISE OF ALLOWANCE RPT JAN 16,1997 ;

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

 ;

START ; EP

 ; Collections report using FM print

 ;

S ;

 N DIR

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

 S DIR("A")="ADVICE OF ALLOWANCE Report type"

 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 ;

 Q

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

 ;

DATE ; EP

 ; Select Date Range

 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"))

 Q

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

 ;

PRINT ;

 ; Print

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

 S DIC="90050.03"

 S L=0

 S FR=BAR("BDOS")_",PAYMENT,"

 S TO=BAR("EDOS")_",PAYMENT,"

 D EN1^DIP

 ;

DSP ; EP for VALM

 D ^%ZISC,HOME^%ZIS

 Q

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

 ;

DIPVAR ;

 ; Set up DIP variables and Header routine

 Q:$D(BAREFLG)

 S BY="'@.01,@101,+4:108;S2;"" """

 D:BAR("RPTYPE")="D" DETAIL

 D:BAR("RPTYPE")="S" SUMMARY

 Q

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

 ;

DETAIL ;

 S DHD="[BAR ADAL HDR]"

 S FLDS="NUMDATE4(#12),4;L20,6;L20,&3.5;R10;D2"  ;Y2000

 Q

 ;

SUMMARY ;

 S FLDS="&3.5;R10;D2;C56"

 S DHD="[BAR ADALS HDR]"

 Q

BARRADAL  ; IHS/SD/LSL - ADVISE OF ALLOWANCE RPT JAN 16,1997 ;

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

 +2       ;

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")="ADVICE OF ALLOWANCE Report type"

 +4        DO ^DIR

 +5        KILL DIR

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

               QUIT 

 +7        SET BAR("RPTYPE")=Y

 +8        DO DATE

 +9        IF $DATA(BAREFLG)

               GOTO END

 +10       DO DIPVAR

 +11       DO PRINT

 +12       DO EOP^BARUTL(1)

 +13      ;

END       ;

 +1        QUIT 

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

 +3       ;

DATE      ; EP

 +1       ; Select Date Range

 +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        SET FR=BAR("BDOS")_",PAYMENT,"

 +6        SET TO=BAR("EDOS")_",PAYMENT,"

 +7        DO EN1^DIP

 +8       ;

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,+4:108;S2;"" """

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

               DO DETAIL

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

               DO SUMMARY

 +6        QUIT 

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

 +8       ;

DETAIL    ;

 +1        SET DHD="[BAR ADAL HDR]"

 +2       ;Y2000

           SET FLDS="NUMDATE4(#12),4;L20,6;L20,&3.5;R10;D2"

 +3        QUIT 

 +4       ;

SUMMARY   ;

 +1        SET FLDS="&3.5;R10;D2;C56"

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

 +3        QUIT