IB20P402.m

IB20P402 ;ALB/CXW - SPECIALTY CODE IN FILE #399;09-SEP-08

 ;;2.0;INTEGRATED BILLING;**402**;21-MAR-94;Build 17

 ;;Per VHA Directive 2004-038, this routine should not be modified.

POST ;

START N U S U="^"

 D BMES^XPDUTL("Add the specialty code to file (#399), Post-Install Starting")

ADD ;

 ;add the specialty to Field ID .08/subfile 399.0222

 ;the bill status is 1 - entered/not reviewed

 N DA,DA2,BILL,NUM,PRV,REC,SPEC,IBDT

 S DA=0,NUM=0

 F  S DA=$O(^DGCR(399,DA)) Q:'DA  I $P($G(^DGCR(399,DA,0)),U,13)=1 D

 . S DA2=0,BILL=$P($G(^DGCR(399,DA,0)),U)

 . F  S DA2=$O(^DGCR(399,DA,"PRV",DA2)) Q:'DA2  D

 .. L +^DGCR(399,DA):1 I '$T D MES^XPDUTL("*7 ANOTHER USER IS EDITING BILL# "_BILL) Q

 .. S REC=$G(^DGCR(399,DA,"PRV",DA2,0))

 .. S PRV=$P(REC,U,2),IBDT=$P($G(^DGCR(399,DA,"U")),U)

 .. S SPEC=$$SPEC^IBCEU(PRV,IBDT)

 .. I $P(REC,U,8)="",SPEC'="" D

 ... S $P(^DGCR(399,DA,"PRV",DA2,0),U,8)=SPEC

 ... I PRV'["IBA(355.93" S PRV=$P($G(^VA(200,+PRV,0)),U)

 ... I PRV["IBA(355.93" S PRV=$P($G(^IBA(355.93,+PRV,0)),U)

 ... D MES^XPDUTL("Specialty Code "_SPEC_" for provider "_PRV_" added to bill# "_BILL)

 ... S NUM=NUM+1

 .. L -^DGCR(399,DA)

 D BMES^XPDUTL("Total "_NUM_$S(NUM=1:"bill has",1:" bills have")_" been updated")

 ;

FINISH ;

 D BMES^XPDUTL("Add the specialty code to file (#399), Post-Install Complete")

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---IB20P402   1345     printed  Apr 09, 2024@21:13:43                                                                                                                                                                                                    Page 2

IB20P402  ;ALB/CXW - SPECIALTY CODE IN FILE #399;09-SEP-08

 +1       ;;2.0;INTEGRATED BILLING;**402**;21-MAR-94;Build 17

 +2       ;;Per VHA Directive 2004-038, this routine should not be modified.

POST      ;

START      NEW U

           SET U="^"

 +1        DO BMES^XPDUTL("Add the specialty code to file (#399), Post-Install Starting")

ADD       ;

 +1       ;add the specialty to Field ID .08/subfile 399.0222

 +2       ;the bill status is 1 - entered/not reviewed

 +3        NEW DA,DA2,BILL,NUM,PRV,REC,SPEC,IBDT

 +4        SET DA=0

           SET NUM=0

 +5        FOR 

               SET DA=$ORDER(^DGCR(399,DA))

               if 'DA

                   QUIT 

               IF $PIECE($GET(^DGCR(399,DA,0)),U,13)=1

                   Begin DoDot:1

 +6                    SET DA2=0

                       SET BILL=$PIECE($GET(^DGCR(399,DA,0)),U)

 +7                    FOR 

                           SET DA2=$ORDER(^DGCR(399,DA,"PRV",DA2))

                           if 'DA2

                               QUIT 

                           Begin DoDot:2

 +8                            LOCK +^DGCR(399,DA):1

                               IF '$TEST

                                   DO MES^XPDUTL("*7 ANOTHER USER IS EDITING BILL# "_BILL)

                                   QUIT 

 +9                            SET REC=$GET(^DGCR(399,DA,"PRV",DA2,0))

 +10                           SET PRV=$PIECE(REC,U,2)

                               SET IBDT=$PIECE($GET(^DGCR(399,DA,"U")),U)

 +11                           SET SPEC=$$SPEC^IBCEU(PRV,IBDT)

 +12                           IF $PIECE(REC,U,8)=""

                                   IF SPEC'=""

                                       Begin DoDot:3

 +13                                       SET $PIECE(^DGCR(399,DA,"PRV",DA2,0),U,8)=SPEC

 +14                                       IF PRV'["IBA(355.93"

                                               SET PRV=$PIECE($GET(^VA(200,+PRV,0)),U)

 +15                                       IF PRV["IBA(355.93"

                                               SET PRV=$PIECE($GET(^IBA(355.93,+PRV,0)),U)

 +16                                       DO MES^XPDUTL("Specialty Code "_SPEC_" for provider "_PRV_" added to bill# "_BILL)

 +17                                       SET NUM=NUM+1

                                       End DoDot:3

 +18                           LOCK -^DGCR(399,DA)

                           End DoDot:2

                   End DoDot:1

 +19       DO BMES^XPDUTL("Total "_NUM_$SELECT(NUM=1:"bill has",1:" bills have")_" been updated")

 +20      ;

FINISH    ;

 +1        DO BMES^XPDUTL("Add the specialty code to file (#399), Post-Install Complete")

 +2        QUIT 

 +3       ;