BARRPTU0.m

BARRPTU0 ; IHS/SD/LSL - USER REPORTS ;

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

 ;;

SELECT ; EP

 K DIC,DR,DA,DIE

 S DIC=$$DIC^XBDIQ1(90055.06)

 S DIC("W")="W ?40,$$VAL^XBDIQ1(90055.06,+Y,.02)"

 S DIC(0)="AEQML"

 D ^DIC

 Q:Y'>0

 S DA=+Y

 S DR=".01;.02"

 S DIE=DIC

 D ^DIE

 S BARFN=$$GET1^DIQ(90055.06,DA,.02,"I")

 K DR

 S DR=".03;.04;.05"

 D ^DIE

 S BARFN=$$VALI^XBDIQ1(90055.06,DA,.02)

 D USRRPT

 K DIR

 S DIR("A")="CR - Continue"

 D EOP^BARUTL(0)

 G SELECT

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

 ;

SORT ; EP

 S BARFN=$$GET1^DIQ(90055.06,DA,.02,"I")

 Q:'BARFN

 D EN^XBNEW("S1^BARRPTU0","BARFN")

 Q

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

 ;

S1 ; EP

 K DIC

 S L=0

 S DIC="^DIBT("

 S DIS(0)="I $P(^DIBT(D0,0),U,4)=BARFN"

 S BY=".01;S2"

 S FR="A"

 S TO="z"

 S FLDS="""*******"";C1;S2,.01;C1,""*******"";C1,1620"

 S DHD="SORT Templates for "_$$GET1^DIQ(1,BARFN,.01)

 D VIEWD^XBLM("EN1^DIP")

 Q

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

 ;

PRINT ; EP

 ; XBLM print templates for the file

 S BARFN=$$GET1^DIQ(90055.06,DA,.02,"I")

 Q:'BARFN

 D EN^XBNEW("P1^BARRPTU0","BAR*")

 Q

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

 ;

P1 ; EP

 K DIC

 S L=0

 S DIC="^DIPT("

 S DIS(0)="I $P(^DIPT(D0,0),U,4)=BARFN"

 S BY=".01;S2"

 S FR="A"

 S TO="z"

 S FLDS="""*******"";C1;S2,.01;C1,""*******"";C1,1620"

 S DHD="PRINT Templates for "_$$GET1^DIQ(1,BARFN,.01)

 D VIEWD^XBLM("EN1^DIP")

 Q

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

 ;

USRRPT ;EP - run the user report

 S X=$$GET1^DIQ(90055.06,DA,.05,"I")

 Q:'X

 S BARURDA=DA

 W $$EN^BARVDF("IOF")

 W "Running the report:   ",$$GET1^DIQ(90055.06,DA,.01),!

 D EN^XBNEW("US0^BARRPTU0","BAR*")

 Q

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

 ;

US0 ; EP

 ; run the report

 S DIC=$$DIC^XBDIQ1(BARFN)

 S FLDS=$$GET1^DIQ(90055.06,BARURDA,.04)

 S BY=$$GET1^DIQ(90055.06,BARURDA,.03)

 S L=0

 I $L(FLDS),$L(BY)

 E  Q

 S FLDS="["_FLDS_"]",BY="["_BY_"]"

 D EN1^DIP

 Q

BARRPTU0  ; IHS/SD/LSL - USER REPORTS ;

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

 +2       ;;

SELECT    ; EP

 +1        KILL DIC,DR,DA,DIE

 +2        SET DIC=$$DIC^XBDIQ1(90055.06)

 +3        SET DIC("W")="W ?40,$$VAL^XBDIQ1(90055.06,+Y,.02)"

 +4        SET DIC(0)="AEQML"

 +5        DO ^DIC

 +6        IF Y'>0

               QUIT 

 +7        SET DA=+Y

 +8        SET DR=".01;.02"

 +9        SET DIE=DIC

 +10       DO ^DIE

 +11       SET BARFN=$$GET1^DIQ(90055.06,DA,.02,"I")

 +12       KILL DR

 +13       SET DR=".03;.04;.05"

 +14       DO ^DIE

 +15       SET BARFN=$$VALI^XBDIQ1(90055.06,DA,.02)

 +16       DO USRRPT

 +17       KILL DIR

 +18       SET DIR("A")="CR - Continue"

 +19       DO EOP^BARUTL(0)

 +20       GOTO SELECT

 +21      ; *********************************************************************

 +22      ;

SORT      ; EP

 +1        SET BARFN=$$GET1^DIQ(90055.06,DA,.02,"I")

 +2        IF 'BARFN

               QUIT 

 +3        DO EN^XBNEW("S1^BARRPTU0","BARFN")

 +4        QUIT 

 +5       ; *********************************************************************

 +6       ;

S1        ; EP

 +1        KILL DIC

 +2        SET L=0

 +3        SET DIC="^DIBT("

 +4        SET DIS(0)="I $P(^DIBT(D0,0),U,4)=BARFN"

 +5        SET BY=".01;S2"

 +6        SET FR="A"

 +7        SET TO="z"

 +8        SET FLDS="""*******"";C1;S2,.01;C1,""*******"";C1,1620"

 +9        SET DHD="SORT Templates for "_$$GET1^DIQ(1,BARFN,.01)

 +10       DO VIEWD^XBLM("EN1^DIP")

 +11       QUIT 

 +12      ; *********************************************************************

 +13      ;

PRINT     ; EP

 +1       ; XBLM print templates for the file

 +2        SET BARFN=$$GET1^DIQ(90055.06,DA,.02,"I")

 +3        IF 'BARFN

               QUIT 

 +4        DO EN^XBNEW("P1^BARRPTU0","BAR*")

 +5        QUIT 

 +6       ; *********************************************************************

 +7       ;

P1        ; EP

 +1        KILL DIC

 +2        SET L=0

 +3        SET DIC="^DIPT("

 +4        SET DIS(0)="I $P(^DIPT(D0,0),U,4)=BARFN"

 +5        SET BY=".01;S2"

 +6        SET FR="A"

 +7        SET TO="z"

 +8        SET FLDS="""*******"";C1;S2,.01;C1,""*******"";C1,1620"

 +9        SET DHD="PRINT Templates for "_$$GET1^DIQ(1,BARFN,.01)

 +10       DO VIEWD^XBLM("EN1^DIP")

 +11       QUIT 

 +12      ; *********************************************************************

 +13      ;

USRRPT    ;EP - run the user report

 +1        SET X=$$GET1^DIQ(90055.06,DA,.05,"I")

 +2        IF 'X

               QUIT 

 +3        SET BARURDA=DA

 +4        WRITE $$EN^BARVDF("IOF")

 +5        WRITE "Running the report:   ",$$GET1^DIQ(90055.06,DA,.01),!

 +6        DO EN^XBNEW("US0^BARRPTU0","BAR*")

 +7        QUIT 

 +8       ; *********************************************************************

 +9       ;

US0       ; EP

 +1       ; run the report

 +2        SET DIC=$$DIC^XBDIQ1(BARFN)

 +3        SET FLDS=$$GET1^DIQ(90055.06,BARURDA,.04)

 +4        SET BY=$$GET1^DIQ(90055.06,BARURDA,.03)

 +5        SET L=0

 +6        IF $LENGTH(FLDS)

               IF $LENGTH(BY)

 +7       IF '$TEST

               QUIT 

 +8        SET FLDS="["_FLDS_"]"

           SET BY="["_BY_"]"

 +9        DO EN1^DIP

 +10       QUIT