BARTBLED.m

BARTBLED ; IHS/SD/LSL - TYPES 'N' CATEGORIES EDIT DEC 4,1996 ;

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

 ;

 ; IHS/SD/LSL - 10/16/02 - HIPAA

 ;       Modified to include new adjustment categories in screen.

 ;

 ; IHS/SD/AML - 11/2/2010 - SENT TO COLLECTION Adjustment codes

 ;	Modified report to include new 'SENT TO COLLECTION' items.

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

 ;

TYPE ;EP

 ; select TYPE and then ENTRY

 W !!

 K DIC

 S DIC="^BAR(90052.01,"

 S DIC(0)="AEQMZ"

 S DIC("A")="TYPE OF TABLE: "

 D ^DIC

 G:Y'>0 EXIT

 S (DA,BARDA1)=+Y

 K DIE

 S DIE=DIC

 S DR=".01"

 I $P(^BAR(90052.01,DA,0),U,2)']"" S DR=DR_";2"

 S DIDEL=90050

 D ^DIE

 K DIDEL,DIE

 ;

SKP ;

 S BARAC=$P(^BAR(90052.01,BARDA1,0),"^",2)

 ;

ENTRY ;

 ; edit ENTRY

 W !!

 ; adjust table entry numbers as to local or distributed

 I ^%ZOSF("PROD")="PRD,DSD" S X=$O(^BARTBL(999),-1),$P(^BARTBL(0),U,3,4)=X_U_X,BARY=1 I 1

 E  S X=1000,$P(^BARTBL(0),U,3,4)=X_U_X,BARY=1000

 K DIC

 S DIC="^BARTBL("

 S DIC(0)="AEQML"

 S DIC("S")="S BARPT=$P(^(0),U,2) I +Y>BARY,(BARPT="""")!(BARPT=BARDA1)"

 S DIC("A")="TABLE ENTRY: "

 D ^DIC

 G:Y'>0 TYPE

 S DA=+Y

 K DIE

 S DIE=DIC

 S DR="2////"_BARDA1_";.01;4;5;6"

 S DIDEL=90050

 D ^DIE

 K DIDEL,DIE

 G ENTRY

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

 ;

EXIT ;EP

 K BARDA1,DIC,DIE,BARPT

 Q

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

 ;

PRT ;EP - print adjustment types

 S DIC=90052.02

 S DHD="A/R Posting Categories & Elements"

 S FLDS="[BAR TYPE,IEN;IEN,.01]"

 S BY="[BAR TABLE TYPE:IEN;IEN]"

 ;S DIS(0)="N Z S Z=$P(^BARTBL(D0,0),U,2) I (Z=3)!(Z=4)!(Z=13)!(Z=14)!(Z=15)!(Z=16)!(Z=19)!(Z=20)!(Z=21)!(Z=22)"  ;IHS/SD/AML 11/2/2010

 S DIS(0)="N Z S Z=$P(^BARTBL(D0,0),U,2) I (Z=3)!(Z=4)!(Z=13)!(Z=14)!(Z=15)!(Z=16)!(Z=19)!(Z=20)!(Z=21)!(Z=22)!(Z=25)"  ;IHS/SD/AML 11/2/2010 - MODIFY TO PRINT BAD DEBT

 D EN1^DIP

 Q

BARTBLED  ; IHS/SD/LSL - TYPES 'N' CATEGORIES EDIT DEC 4,1996 ;

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

 +2       ;

 +3       ; IHS/SD/LSL - 10/16/02 - HIPAA

 +4       ;       Modified to include new adjustment categories in screen.

 +5       ;

 +6       ; IHS/SD/AML - 11/2/2010 - SENT TO COLLECTION Adjustment codes

 +7       ;	Modified report to include new 'SENT TO COLLECTION' items.

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

 +9       ;

TYPE      ;EP

 +1       ; select TYPE and then ENTRY

 +2        WRITE !!

 +3        KILL DIC

 +4        SET DIC="^BAR(90052.01,"

 +5        SET DIC(0)="AEQMZ"

 +6        SET DIC("A")="TYPE OF TABLE: "

 +7        DO ^DIC

 +8        IF Y'>0

               GOTO EXIT

 +9        SET (DA,BARDA1)=+Y

 +10       KILL DIE

 +11       SET DIE=DIC

 +12       SET DR=".01"

 +13       IF $PIECE(^BAR(90052.01,DA,0),U,2)']""

               SET DR=DR_";2"

 +14       SET DIDEL=90050

 +15       DO ^DIE

 +16       KILL DIDEL,DIE

 +17      ;

SKP       ;

 +1        SET BARAC=$PIECE(^BAR(90052.01,BARDA1,0),"^",2)

 +2       ;

ENTRY     ;

 +1       ; edit ENTRY

 +2        WRITE !!

 +3       ; adjust table entry numbers as to local or distributed

 +4        IF ^%ZOSF("PROD")="PRD,DSD"

               SET X=$ORDER(^BARTBL(999),-1)

               SET $PIECE(^BARTBL(0),U,3,4)=X_U_X

               SET BARY=1

               IF 1

 +5       IF '$TEST

               SET X=1000

               SET $PIECE(^BARTBL(0),U,3,4)=X_U_X

               SET BARY=1000

 +6        KILL DIC

 +7        SET DIC="^BARTBL("

 +8        SET DIC(0)="AEQML"

 +9        SET DIC("S")="S BARPT=$P(^(0),U,2) I +Y>BARY,(BARPT="""")!(BARPT=BARDA1)"

 +10       SET DIC("A")="TABLE ENTRY: "

 +11       DO ^DIC

 +12       IF Y'>0

               GOTO TYPE

 +13       SET DA=+Y

 +14       KILL DIE

 +15       SET DIE=DIC

 +16       SET DR="2////"_BARDA1_";.01;4;5;6"

 +17       SET DIDEL=90050

 +18       DO ^DIE

 +19       KILL DIDEL,DIE

 +20       GOTO ENTRY

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

 +22      ;

EXIT      ;EP

 +1        KILL BARDA1,DIC,DIE,BARPT

 +2        QUIT 

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

 +4       ;

PRT       ;EP - print adjustment types

 +1        SET DIC=90052.02

 +2        SET DHD="A/R Posting Categories & Elements"

 +3        SET FLDS="[BAR TYPE,IEN;IEN,.01]"

 +4        SET BY="[BAR TABLE TYPE:IEN;IEN]"

 +5       ;S DIS(0)="N Z S Z=$P(^BARTBL(D0,0),U,2) I (Z=3)!(Z=4)!(Z=13)!(Z=14)!(Z=15)!(Z=16)!(Z=19)!(Z=20)!(Z=21)!(Z=22)"  ;IHS/SD/AML 11/2/2010

 +6       ;IHS/SD/AML 11/2/2010 - MODIFY TO PRINT BAD DEBT

           SET DIS(0)="N Z S Z=$P(^BARTBL(D0,0),U,2) I (Z=3)!(Z=4)!(Z=13)!(Z=14)!(Z=15)!(Z=16)!(Z=19)!(Z=20)!(Z=21)!(Z=22)!(Z=25)"

 +7        DO EN1^DIP

 +8        QUIT