- 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 Jan 18, 2025@03:06:34 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