Routine: IB20P191

IB20P191 ;ALB/ARH - IB*2*191 POST INIT: EDI UPDATES ; 08/12/02

 ;;2.0;INTEGRATED BILLING;**191**;21-MAR-94

PRE ;

 N IBA

 S IBA(1)="",IBA(2)="    IB*2*191 Pre-Install .....",IBA(3)="" D MES^XPDUTL(.IBA) K IBA

 D INSXRF ; delete trigger cross references in 399

 S IBA(1)="",IBA(2)="    IB*2*191 Pre-Install Complete",IBA(3)="" D MES^XPDUTL(.IBA) K IBA

INSXRF ; PRE-INSTALL - delete trigger cross references

 N IBA

 D DELIX^DDMOD(399,24,2) S IBA(1)="    >> ^DD(399,24) cross-reference #2 deleted" D MES^XPDUTL(.IBA) K IBA

 D DELIX^DDMOD(399,24,3) S IBA(1)="    >> ^DD(399,24) cross-reference #3 deleted" D MES^XPDUTL(.IBA) K IBA

 D DELIX^DDMOD(399,101,1) S IBA(1)="    >> ^DD(399,101) cross-reference #1 deleted (re-installed)" D MES^XPDUTL(.IBA) K IBA

 D DELIX^DDMOD(399,102,2) S IBA(1)="    >> ^DD(399,102) cross-reference #2 deleted (re-installed)" D MES^XPDUTL(.IBA) K IBA

 D DELIX^DDMOD(399,103,2) S IBA(1)="    >> ^DD(399,103) cross-reference #2 deleted (re-installed)" D MES^XPDUTL(.IBA) K IBA

POST ;

 N IBA

 S IBA(1)="",IBA(2)="    IB*2*191 Post-Install .....",IBA(3)="" D MES^XPDUTL(.IBA) K IBA

 D CLEAN ; Delete incomplete hanging nodes in the EDI Message file (364.2)

 D STATUS ; Update the resubmitted bills' status and new batch pointer

 D INSPRV ; Copy Ins Hospital Provider Number to Professional Provider Number

 S IBA(1)="",IBA(2)="    IB*2*191 Post-Install Complete",IBA(3)="" D MES^XPDUTL(.IBA) K IBA

CLEAN ; Clean left over nodes from the EDI Message File (364.2) - any node where there is no .01 field defined

 N IBA,IBX,IBFN,IBCNT,DA,DIK,DIC,X,Y S IBCNT=0

 F IBX="ABA","ABI","AMAN","AMD","AMS","AMT","ARD","ASCD","B","C" K ^IBA(364.2,IBX)

 S IBFN=0 F  S IBFN=$O(^IBA(364.2,IBFN)) Q:'IBFN  D

 . I $P($G(^IBA(364.2,IBFN,0)),U,1)="" S DA=IBFN,DIK="^IBA(364.2," D ^DIK S IBCNT=IBCNT+1

 S DIK="^IBA(364.2," D IXALL^DIK

 S IBA(1)="    >> Cleaning the EDI Message File (364.2), deleting incomplete nodes. "_IBCNT D MES^XPDUTL(.IBA) K IBA

STATUS ;  Update the resubmitted bills' status and new batch pointer

 ;  Assume the bills are in the file in IEN order that corresponds to

 ;  the order in which they were transmitted.  Starting at the last one

 ;  transmitted (highest IEN), look at the entry just before it and

 ;  assume the earlier one was resubmitted in the later one's batch.

 ;  Update the status if it's one of the standard ones from the return

 ;  message (P, A0, A1, or A2).

 N IBA,IBO,IBO0,IBN,IBN0,IBZ,Z,DR,DA,DIE,DIC,X,Y

 S IBZ=0 F  S IBZ=$O(^IBA(364,"B",IBZ)) Q:'IBZ  S Z=$O(^IBA(364,"B",IBZ,0)) I $O(^IBA(364,"B",IBZ,Z)) D

 . S IBN="" F  S IBN=$O(^IBA(364,"B",IBZ,IBN),-1) Q:IBN=""  D  Q:'IBO

 .. S IBO=$O(^IBA(364,"B",IBZ,IBN),-1)

 .. Q:'IBO  ; No earlier transmit

 .. S IBO0=$G(^IBA(364,IBO,0)),IBN0=$G(^IBA(364,IBN,0))

 .. Q:$P(IBO0,U,6)  ; Already has a resubmitted batch #

 .. S DR=".06////"_$P(IBN0,U,2) ; Update new batch # into old record

 .. I "P A0 A1 A2"[$P(IBO0,U,3) S DR=DR_";.03////R" ;Update status of old

 .. S DIE="^IBA(364,",DA=IBO D ^DIE

 S IBA(1)="    >> Updating the resubmitted bills' status and new batch pointer" D MES^XPDUTL(.IBA) K IBA

INSPRV ; Copy Hospital Provider Number (36,.11) into new field Professional Provider Number (36,.17)

 N IBA,IBFN,IB0,IBHP,IBPP,DA,DR,DIC,DIE,X,Y,IBCNT S IBCNT=0

 S IBFN=0 F  S IBFN=$O(^DIC(36,IBFN)) Q:'IBFN  D

 . S IB0=$G(^DIC(36,IBFN,0))

 . S IBHP=$P(IB0,U,11) Q:IBHP=""

 . S IBPP=$P(IB0,U,17) Q:IBPP'=""

. ;

 . S DIE="^DIC(36,",DA=IBFN,DR=".17////"_IBHP D ^DIE K DA,DR,DIC,DIE S IBCNT=IBCNT+1

 S IBA(1)="    >> Copy Ins Hospital Provider Number to Professional Provider Number "_IBCNT D MES^XPDUTL(.IBA) K IBA

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P191   3794     printed  Mar 13, 2025@21:06:33                                                                                                                                                                                                    Page 2

IB20P191  ;ALB/ARH - IB*2*191 POST INIT: EDI UPDATES ; 08/12/02

 +1       ;;2.0;INTEGRATED BILLING;**191**;21-MAR-94

 +2       ;

 +3       ;

 +4        QUIT

PRE       ;

 +1        NEW IBA

 +2        SET IBA(1)=""

           SET IBA(2)="    IB*2*191 Pre-Install ....."

           SET IBA(3)=""

           DO MES^XPDUTL(.IBA)

           KILL IBA

 +3       ;

 +4       ; delete trigger cross references in 399

           DO INSXRF

 +5       ;

 +6        SET IBA(1)=""

           SET IBA(2)="    IB*2*191 Pre-Install Complete"

           SET IBA(3)=""

           DO MES^XPDUTL(.IBA)

           KILL IBA

 +7        QUIT

 +8       ;

INSXRF    ; PRE-INSTALL - delete trigger cross references

 +1        NEW IBA

 +2       ;

 +3        DO DELIX^DDMOD(399,24,2)

           SET IBA(1)="    >> ^DD(399,24) cross-reference #2 deleted"

           DO MES^XPDUTL(.IBA)

           KILL IBA

 +4       ;

 +5        DO DELIX^DDMOD(399,24,3)

           SET IBA(1)="    >> ^DD(399,24) cross-reference #3 deleted"

           DO MES^XPDUTL(.IBA)

           KILL IBA

 +6       ;

 +7        DO DELIX^DDMOD(399,101,1)

           SET IBA(1)="    >> ^DD(399,101) cross-reference #1 deleted (re-installed)"

           DO MES^XPDUTL(.IBA)

           KILL IBA

 +8       ;

 +9        DO DELIX^DDMOD(399,102,2)

           SET IBA(1)="    >> ^DD(399,102) cross-reference #2 deleted (re-installed)"

           DO MES^XPDUTL(.IBA)

           KILL IBA

 +10      ;

 +11       DO DELIX^DDMOD(399,103,2)

           SET IBA(1)="    >> ^DD(399,103) cross-reference #2 deleted (re-installed)"

           DO MES^XPDUTL(.IBA)

           KILL IBA

 +12       QUIT

POST      ;

 +1        NEW IBA

 +2        SET IBA(1)=""

           SET IBA(2)="    IB*2*191 Post-Install ....."

           SET IBA(3)=""

           DO MES^XPDUTL(.IBA)

           KILL IBA

 +3       ;

 +4       ; Delete incomplete hanging nodes in the EDI Message file (364.2)

           DO CLEAN

 +5       ; Update the resubmitted bills' status and new batch pointer

           DO STATUS

 +6       ; Copy Ins Hospital Provider Number to Professional Provider Number

           DO INSPRV

 +7       ;

 +8        SET IBA(1)=""

           SET IBA(2)="    IB*2*191 Post-Install Complete"

           SET IBA(3)=""

           DO MES^XPDUTL(.IBA)

           KILL IBA

 +9        QUIT

 +10      ;

 +11      ;

CLEAN     ; Clean left over nodes from the EDI Message File (364.2) - any node where there is no .01 field defined

 +1        NEW IBA,IBX,IBFN,IBCNT,DA,DIK,DIC,X,Y

           SET IBCNT=0

 +2       ;

 +3        FOR IBX="ABA","ABI","AMAN","AMD","AMS","AMT","ARD","ASCD","B","C"

               KILL ^IBA(364.2,IBX)

 +4       ;

 +5        SET IBFN=0

FOR

               SET IBFN=$ORDER(^IBA(364.2,IBFN))

               if 'IBFN

                   QUIT

               Begin DoDot:1

 +6                IF $PIECE($GET(^IBA(364.2,IBFN,0)),U,1)=""

                       SET DA=IBFN

                       SET DIK="^IBA(364.2,"

                       DO ^DIK

                       SET IBCNT=IBCNT+1

               End DoDot:1

 +7       ;

 +8        SET DIK="^IBA(364.2,"

           DO IXALL^DIK

 +9       ;

 +10       SET IBA(1)="    >> Cleaning the EDI Message File (364.2), deleting incomplete nodes. "_IBCNT

           DO MES^XPDUTL(.IBA)

           KILL IBA

 +11       QUIT

 +12      ;

 +13      ;

STATUS    ;  Update the resubmitted bills' status and new batch pointer

 +1       ;  Assume the bills are in the file in IEN order that corresponds to

 +2       ;  the order in which they were transmitted.  Starting at the last one

 +3       ;  transmitted (highest IEN), look at the entry just before it and

 +4       ;  assume the earlier one was resubmitted in the later one's batch.

 +5       ;  Update the status if it's one of the standard ones from the return

 +6       ;  message (P, A0, A1, or A2).

 +7       ;

 +8        NEW IBA,IBO,IBO0,IBN,IBN0,IBZ,Z,DR,DA,DIE,DIC,X,Y

 +9        SET IBZ=0

FOR

               SET IBZ=$ORDER(^IBA(364,"B",IBZ))

               if 'IBZ

                   QUIT

               SET Z=$ORDER(^IBA(364,"B",IBZ,0))

               IF $ORDER(^IBA(364,"B",IBZ,Z))

                   Begin DoDot:1

 +10                   SET IBN=""

FOR

                           SET IBN=$ORDER(^IBA(364,"B",IBZ,IBN),-1)

                           if IBN=""

                               QUIT

                           Begin DoDot:2

 +11                           SET IBO=$ORDER(^IBA(364,"B",IBZ,IBN),-1)

 +12      ; No earlier transmit

                               if 'IBO

                                   QUIT

 +13                           SET IBO0=$GET(^IBA(364,IBO,0))

                               SET IBN0=$GET(^IBA(364,IBN,0))

 +14      ; Already has a resubmitted batch #

                               if $PIECE(IBO0,U,6)

                                   QUIT

 +15      ; Update new batch # into old record

                               SET DR=".06////"_$PIECE(IBN0,U,2)

 +16      ;Update status of old

                               IF "P A0 A1 A2"[$PIECE(IBO0,U,3)

                                   SET DR=DR_";.03////R"

 +17                           SET DIE="^IBA(364,"

                               SET DA=IBO

                               DO ^DIE

                           End DoDot:2

                           if 'IBO

                               QUIT

                   End DoDot:1

 +18      ;

 +19       SET IBA(1)="    >> Updating the resubmitted bills' status and new batch pointer"

           DO MES^XPDUTL(.IBA)

           KILL IBA

 +20       QUIT

 +21      ;

 +22      ;

INSPRV    ; Copy Hospital Provider Number (36,.11) into new field Professional Provider Number (36,.17)

 +1        NEW IBA,IBFN,IB0,IBHP,IBPP,DA,DR,DIC,DIE,X,Y,IBCNT

           SET IBCNT=0

 +2       ;

 +3        SET IBFN=0

FOR

               SET IBFN=$ORDER(^DIC(36,IBFN))

               if 'IBFN

                   QUIT

               Begin DoDot:1

 +4                SET IB0=$GET(^DIC(36,IBFN,0))

 +5                SET IBHP=$PIECE(IB0,U,11)

                   if IBHP=""

                       QUIT

 +6                SET IBPP=$PIECE(IB0,U,17)

                   if IBPP'=""

                       QUIT

 +7       ;

 +8                SET DIE="^DIC(36,"

                   SET DA=IBFN

                   SET DR=".17////"_IBHP

                   DO ^DIE

                   KILL DA,DR,DIC,DIE

                   SET IBCNT=IBCNT+1

               End DoDot:1

 +9       ;

 +10       SET IBA(1)="    >> Copy Ins Hospital Provider Number to Professional Provider Number "_IBCNT

           DO MES^XPDUTL(.IBA)

           KILL IBA

 +11       QUIT

IB20P191.m