IB20PT32.m

IB20PT32	;ALB/CPM - IB V2.0 POST INIT, RESOLVE TABLE POINTERS ; 02-SEP-93

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

	;

ATAT	; Resolve pointers to file #350.1 from file #350.1

	W !!,">>> Updating pointers to file #350.1 from file #350.1... "

	F IBI=1:1 S IBX=$P($T(ACT+IBI),";;",2,99) Q:IBX=""  D

	.S IBNEW=$O(^IBE(350.1,"B",$P(IBX,"^"),0))

	.S IBCAN=$O(^IBE(350.1,"B",$P(IBX,"^",2),0))

	.S IBUPD=$O(^IBE(350.1,"B",$P(IBX,"^",3),0))

	.F IBJ=IBNEW,IBCAN,IBUPD D

	..S DIE="^IBE(350.1,",DA=IBJ

	..S DR=".06////"_IBCAN_";.07////"_IBUPD_";.09////"_IBNEW

	..D ^DIE K DA,DR,DIE W "."

	;

	; - update only new action type

	F IBI=1:1 S IBX=$P($T(ACT1+IBI),";;",2,99) Q:IBX=""  D

	.S IBJ=$O(^IBE(350.1,"B",IBX,0)) Q:'IBJ

	.S DIE="^IBE(350.1,",DA=IBJ,DR=".09////"_IBJ

	.D ^DIE K DA,DR,DIE W "."

	;

	K IBI,IBX,IBNEW,IBCAN,IBUPD,IBJ

	Q

	;

	;

ACT	;New Action (#350.1)^Cancel Action (#350.1)^Update Action (#350.1)

	;;DG CHAMPVA PER DIEM NEW^DG CHAMPVA PER DIEM CANCEL^DG CHAMPVA PER DIEM UPDATE

	;

	; - others that may need to be updated

	;

	;;DG FEE SERVICE (INPT) NEW^DG FEE SERVICE (INPT) CANCEL^DG FEE SERVICE (INPT) UPDATE

	;;DG NHCU COPAY NEW^DG NHCU COPAY CANCEL^DG NHCU COPAY UPDATE

	;;DG NHCU PER DIEM NEW^DG NHCU PER DIEM CANCEL^DG NHCU PER DIEM UPDATE

	;;DG INPT COPAY (ALC) NEW^DG INPT COPAY (ALC) CANCEL^DG INPT COPAY (ALC) UPDATE

	;;DG INPT COPAY (BLI) NEW^DG INPT COPAY (BLI) CANCEL^DG INPT COPAY (BLI) UPDATE

	;;DG INPT COPAY (INT) NEW^DG INPT COPAY (INT) CANCEL^DG INPT COPAY (INT) UPDATE

	;;DG INPT COPAY (MED) NEW^DG INPT COPAY (MED) CANCEL^DG INPT COPAY (MED) UPDATE

	;;DG INPT COPAY (NEU) NEW^DG INPT COPAY (NEU) CANCEL^DG INPT COPAY (NEU) UPDATE

	;;DG INPT COPAY (PSY) NEW^DG INPT COPAY (PSY) CANCEL^DG INPT COPAY (PSY) UPDATE

	;;DG INPT COPAY (REH) NEW^DG INPT COPAY (REH) CANCEL^DG INPT COPAY (REH) UPDATE

	;;DG INPT COPAY (SPI) NEW^DG INPT COPAY (SPI) CANCEL^DG INPT COPAY (SPI) UPDATE

	;;DG INPT COPAY (SUR) NEW^DG INPT COPAY (SUR) CANCEL^DG INPT COPAY (SUR) UPDATE

	;;DG INPT PER DIEM NEW^DG INPT PER DIEM CANCEL^DG INPT PER DIEM UPDATE

	;;DG FEE SERVICE (OPT) NEW^DG FEE SERVICE (OPT) CANCEL^DG FEE SERVICE (OPT) UPDATE

	;;DG OPT COPAY NEW^DG OPT COPAY CANCEL^DG OPT COPAY UPDATE

	;

	;

ACT1	;New Action (#350.1)

	;;CHAMPVA SUBSISTENCE LIMIT

	;

	; - others that may need to be updated

	;

	;;MEDICARE DEDUCTIBLE

	;;HOSPITAL ADMISSION

	;;NHCU ADMISSION

	;;IB OPT MEDICARE RATE 1

	;;IB OPT MEDICARE RATE 2

	;;IB OPT MEDICARE RATE 3

	;;IB OPT MEDICARE RATE 4

	;;IB OPT MEDICARE RATE 5

	;;IB OPT MEDICARE RATE 6

	;;IB OPT MEDICARE RATE 7

	;;IB OPT MEDICARE RATE 8

	;;IB OPT MEDICARE RATE 9

IB20PT32  ;ALB/CPM - IB V2.0 POST INIT, RESOLVE TABLE POINTERS ; 02-SEP-93

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2       ;

ATAT      ; Resolve pointers to file #350.1 from file #350.1

 +1        WRITE !!,">>> Updating pointers to file #350.1 from file #350.1... "

 +2        FOR IBI=1:1

               SET IBX=$PIECE($TEXT(ACT+IBI),";;",2,99)

               IF IBX=""

                   QUIT 

               Begin DoDot:1

 +3                SET IBNEW=$ORDER(^IBE(350.1,"B",$PIECE(IBX,"^"),0))

 +4                SET IBCAN=$ORDER(^IBE(350.1,"B",$PIECE(IBX,"^",2),0))

 +5                SET IBUPD=$ORDER(^IBE(350.1,"B",$PIECE(IBX,"^",3),0))

 +6                FOR IBJ=IBNEW,IBCAN,IBUPD

                       Begin DoDot:2

 +7                        SET DIE="^IBE(350.1,"

                           SET DA=IBJ

 +8                        SET DR=".06////"_IBCAN_";.07////"_IBUPD_";.09////"_IBNEW

 +9                        DO ^DIE

                           KILL DA,DR,DIE

                           WRITE "."

                       End DoDot:2

               End DoDot:1

 +10      ;

 +11      ; - update only new action type

 +12       FOR IBI=1:1

               SET IBX=$PIECE($TEXT(ACT1+IBI),";;",2,99)

               IF IBX=""

                   QUIT 

               Begin DoDot:1

 +13               SET IBJ=$ORDER(^IBE(350.1,"B",IBX,0))

                   IF 'IBJ

                       QUIT 

 +14               SET DIE="^IBE(350.1,"

                   SET DA=IBJ

                   SET DR=".09////"_IBJ

 +15               DO ^DIE

                   KILL DA,DR,DIE

                   WRITE "."

               End DoDot:1

 +16      ;

 +17       KILL IBI,IBX,IBNEW,IBCAN,IBUPD,IBJ

 +18       QUIT 

 +19      ;

 +20      ;

ACT       ;New Action (#350.1)^Cancel Action (#350.1)^Update Action (#350.1)

 +1       ;;DG CHAMPVA PER DIEM NEW^DG CHAMPVA PER DIEM CANCEL^DG CHAMPVA PER DIEM UPDATE

 +2       ;

 +3       ; - others that may need to be updated

 +4       ;

 +5       ;;DG FEE SERVICE (INPT) NEW^DG FEE SERVICE (INPT) CANCEL^DG FEE SERVICE (INPT) UPDATE

 +6       ;;DG NHCU COPAY NEW^DG NHCU COPAY CANCEL^DG NHCU COPAY UPDATE

 +7       ;;DG NHCU PER DIEM NEW^DG NHCU PER DIEM CANCEL^DG NHCU PER DIEM UPDATE

 +8       ;;DG INPT COPAY (ALC) NEW^DG INPT COPAY (ALC) CANCEL^DG INPT COPAY (ALC) UPDATE

 +9       ;;DG INPT COPAY (BLI) NEW^DG INPT COPAY (BLI) CANCEL^DG INPT COPAY (BLI) UPDATE

 +10      ;;DG INPT COPAY (INT) NEW^DG INPT COPAY (INT) CANCEL^DG INPT COPAY (INT) UPDATE

 +11      ;;DG INPT COPAY (MED) NEW^DG INPT COPAY (MED) CANCEL^DG INPT COPAY (MED) UPDATE

 +12      ;;DG INPT COPAY (NEU) NEW^DG INPT COPAY (NEU) CANCEL^DG INPT COPAY (NEU) UPDATE

 +13      ;;DG INPT COPAY (PSY) NEW^DG INPT COPAY (PSY) CANCEL^DG INPT COPAY (PSY) UPDATE

 +14      ;;DG INPT COPAY (REH) NEW^DG INPT COPAY (REH) CANCEL^DG INPT COPAY (REH) UPDATE

 +15      ;;DG INPT COPAY (SPI) NEW^DG INPT COPAY (SPI) CANCEL^DG INPT COPAY (SPI) UPDATE

 +16      ;;DG INPT COPAY (SUR) NEW^DG INPT COPAY (SUR) CANCEL^DG INPT COPAY (SUR) UPDATE

 +17      ;;DG INPT PER DIEM NEW^DG INPT PER DIEM CANCEL^DG INPT PER DIEM UPDATE

 +18      ;;DG FEE SERVICE (OPT) NEW^DG FEE SERVICE (OPT) CANCEL^DG FEE SERVICE (OPT) UPDATE

 +19      ;;DG OPT COPAY NEW^DG OPT COPAY CANCEL^DG OPT COPAY UPDATE

 +20      ;

 +21      ;

ACT1      ;New Action (#350.1)

 +1       ;;CHAMPVA SUBSISTENCE LIMIT

 +2       ;

 +3       ; - others that may need to be updated

 +4       ;

 +5       ;;MEDICARE DEDUCTIBLE

 +6       ;;HOSPITAL ADMISSION

 +7       ;;NHCU ADMISSION

 +8       ;;IB OPT MEDICARE RATE 1

 +9       ;;IB OPT MEDICARE RATE 2

 +10      ;;IB OPT MEDICARE RATE 3

 +11      ;;IB OPT MEDICARE RATE 4

 +12      ;;IB OPT MEDICARE RATE 5

 +13      ;;IB OPT MEDICARE RATE 6

 +14      ;;IB OPT MEDICARE RATE 7

 +15      ;;IB OPT MEDICARE RATE 8

 +16      ;;IB OPT MEDICARE RATE 9