Routine: BARADJC

BARADJC ; IHS/SD/LSL - CREATE 2 NEW ENTRIES IN A/R TABLE TYPE FILE ;

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

 ; IHS/SD/LSL - 09/19/2002 - V1.6 Patch 3

 ;     For HIPAA compliance.  Create 2 new Adjustment Categories

 ;     PENDING and GENERAL INFORMATION

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

ENTRY ;

 ; Create entry

 S BARD=";;"

 F BARIEN=21,22 D EN2

 D ^BARVKL0

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

EN2 ;

 S BARVALUE=$P($T(@BARIEN),BARD,2,3)

 K DIC,DA,X,Y

 S DIC="^BAR(90052.01,"

 S DIC(0)="LZE"

 S DINUM=BARIEN

 S X=$P(BARVALUE,BARD)

 S DIC("DR")="2///^S X=$P(BARVALUE,BARD,2)"

 K DD,DO

 D FILE^DICN

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

 ; NAME;;ACRONYM

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

21 ;;PENDING;;PEND

22 ;;GENERAL INFORMATION;;GENINF

BARADJC   ; IHS/SD/LSL - CREATE 2 NEW ENTRIES IN A/R TABLE TYPE FILE ;

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

 +2       ;

 +3       ; IHS/SD/LSL - 09/19/2002 - V1.6 Patch 3

 +4       ;     For HIPAA compliance.  Create 2 new Adjustment Categories

 +5       ;     PENDING and GENERAL INFORMATION

 +6       ;

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

 +8       ;

ENTRY     ;

 +1       ; Create entry

 +2        SET BARD=";;"

 +3        FOR BARIEN=21,22

               DO EN2

 +4        DO ^BARVKL0

 +5        QUIT

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

 +7       ;

EN2       ;

 +1        SET BARVALUE=$PIECE($TEXT(@BARIEN),BARD,2,3)

 +2        KILL DIC,DA,X,Y

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

 +4        SET DIC(0)="LZE"

 +5        SET DINUM=BARIEN

 +6        SET X=$PIECE(BARVALUE,BARD)

 +7        SET DIC("DR")="2///^S X=$P(BARVALUE,BARD,2)"

 +8        KILL DD,DO

 +9        DO FILE^DICN

 +10       QUIT

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

 +12      ; NAME;;ACRONYM

 +13      ; *********************************************************************

21        ;;PENDING;;PEND

22        ;;GENERAL INFORMATION;;GENINF

BARADJC.m