IB20PT5 ;ALB/CPM - IB V2.0 POST-INIT ONE-TIME ITEMS ; 03-SEP-93
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
; Perform various one-time post-init items
D ACHG ; kill any dangling nodes in the IB ACTION TYPE file
D DEF ; enter the default billing form, if necessary
D STAT ; populate the IB ACTION STATUS (#350.21) file
D BASC ; update the BASC start date to 10/1/99
D PSO ; update eligibility logic for PSO SC RX COPAY NEW (#350.1)
D CRES ; update the cancellation reason MT CHARGE EDITED (#350.3)
D CCMG ; update the central collection mailgroup
D FT ; update form type file
D ABP ; set auto biller parameters
D ^IB20PT51 ; keep going...
Q
;
;
ACHG ; Clean up any IB ACTION CHARGE (#350.2) nodes left hanging.
W !!,">>> Cleaning up dangling nodes in the IB ACTION CHARGE (#350.2) file..."
S I=0 F S I=$O(^IBE(350.2,I)) Q:'I I '$D(^(I,0)) K ^IBE(350.2,I)
Q
;
DEF ; Enter default billing form type.
W !!,">>> Initializing the DEFAULT FORM TYPE, if necessary..."
I '$P($G(^IBE(350.9,1,1)),U,26) S DA=1,DIE="^IBE(350.9,",DR="1.26////1" D ^DIE K DA,DIE,DR
Q
;
BASC ; Update the BASC start date to 10/1/99.
W !!,">>> Updating the BASC start date to 10/1/99..."
S $P(^IBE(350.9,1,1),"^",24)=2991001
Q
;
STAT ; Set new entries into the IB ACTION STATUS (#350.21) file.
W !!,">>> Populating the IB ACTION (#350.21) file... "
K ^IBE(350.21)
S ^IBE(350.21,0)="IB ACTION STATUS^350.21^99^12"
S ^IBE(350.21,1,0)="INCOMPLETE^INCOMPLETE^INC^0^0^0"
S ^IBE(350.21,2,0)="COMPLETE^PENDING A/R^PEND^0^0^0"
S ^IBE(350.21,3,0)="BILLED^BILLED^BILL^1^0^0"
S ^IBE(350.21,4,0)="UPDATED^UPDATED^UPD^1^0^0"
S ^IBE(350.21,8,0)="ON HOLD^ON HOLD (INS)^INS^0^0^1"
S ^IBE(350.21,9,0)="ERROR ENCOUNTERED^ERROR^ERR^0^1^0"
S ^IBE(350.21,10,0)="CANCELLED^CANCELLED^CANC^1^1^0"
S ^IBE(350.21,11,0)="CO-PAY EXEMPTION CANCELLATION^CANCELLED (EXEMPTED)^EXEMPTED^1^1^0"
S ^IBE(350.21,20,0)="HOLD - RATE^ON HOLD (RATE)^RATE^0^0^1"
S ^IBE(350.21,99,0)="CONVERTED RECORD^CONVERTED RECORD^CONV^0^0^0"
S DIK="^IBE(350.21," D IXALL^DIK K DIK
Q
;
CCMG ; Update the central collection mailgroup in file #350.9
W !!,">>> Updating the central collection mailgroup to G.MCCR DATA@DOMAIN.EXT ..."
S IBX="G.MCCR DATA@DOMAIN.EXT"
S DA=1,DIE="^IBE(350.9,",DR="4.05///^S X=IBX" D ^DIE K DA,DR,DIE,IBX
Q
;
CRES ; Update the cancellation reason MT CHARGE EDITED in file #350.3
W !!,">>> Updating the cancellation reason MT CHARGE EDITED in file #350.3 ..."
S DA=$O(^IBE(350.3,"B","MT CHARGE EDITED",0))
I DA S DIE="^IBE(350.3,",DR=".03////2" D ^DIE K DIE,DR,DA
Q
;
FT ; Update called routine for form type HCFA 1500
W !!,">>> Updating the Form Types in #353..."
S IBFT="HCFA 1500" S IBFTI=$O(^IBE(353,"B",IBFT,0)) I +IBFTI S DIE="^IBE(353,",DA=IBFTI,DR="1.01////EN^IBCF2" D ^DIE K DIE,DR,DA
;K DD,DO S DIC="^IBE(353,",DIC(0)="L",X="UB-92",DIC("DR")="1.01////EN^IBCF3" D FILE^DICN K DIC,X
K IBFT,IBFTI
Q
;
PSO ; Update the eligibility logic for PSO SC RX COPAY NEW
W !!,">>> Updating the Eligibility logic for SC veterans for Pharmacy copay..."
S IBNEWSC=$P($T(NEWCODE),";;",2,99)
S IBX="PSO SC RX COPAY NEW",IBDA=+$O(^IBE(350.1,"B",IBX,0))
S ^IBE(350.1,IBDA,40)=IBNEWSC
K IBDA,IBNEWSC,IBX
Q
;
NEWCODE ;;S X=0,X1="",X2="" G:'$D(VAEL) 1^IBAERR I VAEL(4),+VAEL(3),'IBDOM S X=$S($P(VAEL(3),"^",2)<50:2,1:0) I X S:$$RXEXMT^IBARXEU0(DFN,DT) X=0 I X S X2=$P(^IBE(350.1,DA,0),"^",4) D COST^IBAUTL
;
;
ABP ; Set auto biller parameters.
Q:'$G(IBAUTOBP)
W !!,">>> Initializing the AUTO BILLER PARAMETERS ..."
S DA=1,DIE="^IBE(350.9,",DR="7.01////7;7.02////"_DT D ^DIE K DA,DIE,DR
S DA=1,DIE="^IBE(356.6,",DR=".04////1;.06////2" D ^DIE K DA,DIE,DR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20PT5 3805 printed Apr 09, 2024@21:27:56 Page 2
IB20PT5 ;ALB/CPM - IB V2.0 POST-INIT ONE-TIME ITEMS ; 03-SEP-93
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
+3 ; Perform various one-time post-init items
+4 ; kill any dangling nodes in the IB ACTION TYPE file
DO ACHG
+5 ; enter the default billing form, if necessary
DO DEF
+6 ; populate the IB ACTION STATUS (#350.21) file
DO STAT
+7 ; update the BASC start date to 10/1/99
DO BASC
+8 ; update eligibility logic for PSO SC RX COPAY NEW (#350.1)
DO PSO
+9 ; update the cancellation reason MT CHARGE EDITED (#350.3)
DO CRES
+10 ; update the central collection mailgroup
DO CCMG
+11 ; update form type file
DO FT
+12 ; set auto biller parameters
DO ABP
+13 ; keep going...
DO ^IB20PT51
+14 QUIT
+15 ;
+16 ;
ACHG ; Clean up any IB ACTION CHARGE (#350.2) nodes left hanging.
+1 WRITE !!,">>> Cleaning up dangling nodes in the IB ACTION CHARGE (#350.2) file..."
+2 SET I=0
FOR
SET I=$ORDER(^IBE(350.2,I))
if 'I
QUIT
IF '$DATA(^(I,0))
KILL ^IBE(350.2,I)
+3 QUIT
+4 ;
DEF ; Enter default billing form type.
+1 WRITE !!,">>> Initializing the DEFAULT FORM TYPE, if necessary..."
+2 IF '$PIECE($GET(^IBE(350.9,1,1)),U,26)
SET DA=1
SET DIE="^IBE(350.9,"
SET DR="1.26////1"
DO ^DIE
KILL DA,DIE,DR
+3 QUIT
+4 ;
BASC ; Update the BASC start date to 10/1/99.
+1 WRITE !!,">>> Updating the BASC start date to 10/1/99..."
+2 SET $PIECE(^IBE(350.9,1,1),"^",24)=2991001
+3 QUIT
+4 ;
STAT ; Set new entries into the IB ACTION STATUS (#350.21) file.
+1 WRITE !!,">>> Populating the IB ACTION (#350.21) file... "
+2 KILL ^IBE(350.21)
+3 SET ^IBE(350.21,0)="IB ACTION STATUS^350.21^99^12"
+4 SET ^IBE(350.21,1,0)="INCOMPLETE^INCOMPLETE^INC^0^0^0"
+5 SET ^IBE(350.21,2,0)="COMPLETE^PENDING A/R^PEND^0^0^0"
+6 SET ^IBE(350.21,3,0)="BILLED^BILLED^BILL^1^0^0"
+7 SET ^IBE(350.21,4,0)="UPDATED^UPDATED^UPD^1^0^0"
+8 SET ^IBE(350.21,8,0)="ON HOLD^ON HOLD (INS)^INS^0^0^1"
+9 SET ^IBE(350.21,9,0)="ERROR ENCOUNTERED^ERROR^ERR^0^1^0"
+10 SET ^IBE(350.21,10,0)="CANCELLED^CANCELLED^CANC^1^1^0"
+11 SET ^IBE(350.21,11,0)="CO-PAY EXEMPTION CANCELLATION^CANCELLED (EXEMPTED)^EXEMPTED^1^1^0"
+12 SET ^IBE(350.21,20,0)="HOLD - RATE^ON HOLD (RATE)^RATE^0^0^1"
+13 SET ^IBE(350.21,99,0)="CONVERTED RECORD^CONVERTED RECORD^CONV^0^0^0"
+14 SET DIK="^IBE(350.21,"
DO IXALL^DIK
KILL DIK
+15 QUIT
+16 ;
CCMG ; Update the central collection mailgroup in file #350.9
+1 WRITE !!,">>> Updating the central collection mailgroup to G.MCCR DATA@DOMAIN.EXT ..."
+2 SET IBX="G.MCCR DATA@DOMAIN.EXT"
+3 SET DA=1
SET DIE="^IBE(350.9,"
SET DR="4.05///^S X=IBX"
DO ^DIE
KILL DA,DR,DIE,IBX
+4 QUIT
+5 ;
CRES ; Update the cancellation reason MT CHARGE EDITED in file #350.3
+1 WRITE !!,">>> Updating the cancellation reason MT CHARGE EDITED in file #350.3 ..."
+2 SET DA=$ORDER(^IBE(350.3,"B","MT CHARGE EDITED",0))
+3 IF DA
SET DIE="^IBE(350.3,"
SET DR=".03////2"
DO ^DIE
KILL DIE,DR,DA
+4 QUIT
+5 ;
FT ; Update called routine for form type HCFA 1500
+1 WRITE !!,">>> Updating the Form Types in #353..."
+2 SET IBFT="HCFA 1500"
SET IBFTI=$ORDER(^IBE(353,"B",IBFT,0))
IF +IBFTI
SET DIE="^IBE(353,"
SET DA=IBFTI
SET DR="1.01////EN^IBCF2"
DO ^DIE
KILL DIE,DR,DA
+3 ;K DD,DO S DIC="^IBE(353,",DIC(0)="L",X="UB-92",DIC("DR")="1.01////EN^IBCF3" D FILE^DICN K DIC,X
+4 KILL IBFT,IBFTI
+5 QUIT
+6 ;
PSO ; Update the eligibility logic for PSO SC RX COPAY NEW
+1 WRITE !!,">>> Updating the Eligibility logic for SC veterans for Pharmacy copay..."
+2 SET IBNEWSC=$PIECE($TEXT(NEWCODE),";;",2,99)
+3 SET IBX="PSO SC RX COPAY NEW"
SET IBDA=+$ORDER(^IBE(350.1,"B",IBX,0))
+4 SET ^IBE(350.1,IBDA,40)=IBNEWSC
+5 KILL IBDA,IBNEWSC,IBX
+6 QUIT
+7 ;
NEWCODE ;;S X=0,X1="",X2="" G:'$D(VAEL) 1^IBAERR I VAEL(4),+VAEL(3),'IBDOM S X=$S($P(VAEL(3),"^",2)<50:2,1:0) I X S:$$RXEXMT^IBARXEU0(DFN,DT) X=0 I X S X2=$P(^IBE(350.1,DA,0),"^",4) D COST^IBAUTL
+1 ;
+2 ;
ABP ; Set auto biller parameters.
+1 if '$GET(IBAUTOBP)
QUIT
+2 WRITE !!,">>> Initializing the AUTO BILLER PARAMETERS ..."
+3 SET DA=1
SET DIE="^IBE(350.9,"
SET DR="7.01////7;7.02////"_DT
DO ^DIE
KILL DA,DIE,DR
+4 SET DA=1
SET DIE="^IBE(356.6,"
SET DR=".04////1;.06////2"
DO ^DIE
KILL DA,DIE,DR
+5 QUIT
