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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20PT32 2666 printed Dec 13, 2024@02:05:10 Page 2
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
