- IBYPSC ;ALB/ARH - IB*2.0*287 POST INIT: REASONABLE CHARGES V2.2 ; 12/01/04
- ;;2.0;INTEGRATED BILLING;**287**;21-MAR-94
- ;
- Q
- ;
- POST ; post-init routine for IB*2*287 Reasonable Charges v2.2
- N IBA
- S IBA(1)="",IBA(2)=" IB*2*287 Post-Install .....",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
- ;
- D RVA ; activate Revenue Codes (399.2,2)
- ;
- D RVD^IBYPSC1 ; delete existing Revenue Code - CPT Links (#363.33)
- D RVL^IBYPSC1 ; add new/updated Revenue Code - CPT Links (#363.33)
- ;
- S IBA(1)="",IBA(2)=" IB*2*287 Post-Install Complete",IBA(3)="" D MES^XPDUTL(.IBA) K IBA
- Q
- ;
- ;
- ;
- RVA ; activate Revenue Codes exported in RV-CPT links (399.2,2), if currently inactive
- N IBA,IBLN,IBI,IBRV,IBRVFN,IBRVLN,IBACT,IBCNT,IBJ,DD,DO,DIC,DIE,DA,DR,X,Y S IBCNT=0,IBACT=""
- ;
- S IBLN=$P($T(FRVA+1),";;",2)
- ;
- F IBI=1:1 S IBRV=$P(IBLN,",",IBI) Q:IBRV'?3N D
- . ;
- . S IBRVFN=$O(^DGCR(399.2,"B",IBRV,0)) Q:'IBRVFN
- . S IBRVLN=$G(^DGCR(399.2,+IBRVFN,0)) Q:IBRVLN=""
- . I +$P(IBRVLN,U,3) Q
- . ;
- . S IBCNT=IBCNT+1,IBACT=IBACT_IBRV_","
- . S DR="2////1",DIE="^DGCR(399.2,",DA=+IBRVFN D ^DIE K DIE,DIC,DA,DR,X,Y
- ;
- I IBCNT>0 S IBJ=0 F IBI=1:15 S IBJ=IBJ+15 S IBLN=$P(IBACT,",",IBI,IBJ) Q:IBLN="" D MSG(" "_IBLN)
- ;
- RVAQ S IBA(1)=" >> "_IBCNT_" Revenue Codes activated (399.2)..." D MSG(" ")
- D MES^XPDUTL(.IBA)
- Q
- ;
- ;
- MSG(X) ;
- N IBX S IBX=$O(IBA(999999),-1) S:'IBX IBX=1 S IBX=IBX+1
- S IBA(IBX)=$G(X)
- Q
- ;
- FRVA ; Revenue Codes to Activate (399.2,2)
- ;;900,
- ;;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBYPSC 1508 printed Feb 19, 2025@00:03:09 Page 2
- IBYPSC ;ALB/ARH - IB*2.0*287 POST INIT: REASONABLE CHARGES V2.2 ; 12/01/04
- +1 ;;2.0;INTEGRATED BILLING;**287**;21-MAR-94
- +2 ;
- +3 QUIT
- +4 ;
- POST ; post-init routine for IB*2*287 Reasonable Charges v2.2
- +1 NEW IBA
- +2 SET IBA(1)=""
- SET IBA(2)=" IB*2*287 Post-Install ....."
- SET IBA(3)=""
- DO MES^XPDUTL(.IBA)
- KILL IBA
- +3 ;
- +4 ; activate Revenue Codes (399.2,2)
- DO RVA
- +5 ;
- +6 ; delete existing Revenue Code - CPT Links (#363.33)
- DO RVD^IBYPSC1
- +7 ; add new/updated Revenue Code - CPT Links (#363.33)
- DO RVL^IBYPSC1
- +8 ;
- +9 SET IBA(1)=""
- SET IBA(2)=" IB*2*287 Post-Install Complete"
- SET IBA(3)=""
- DO MES^XPDUTL(.IBA)
- KILL IBA
- +10 QUIT
- +11 ;
- +12 ;
- +13 ;
- RVA ; activate Revenue Codes exported in RV-CPT links (399.2,2), if currently inactive
- +1 NEW IBA,IBLN,IBI,IBRV,IBRVFN,IBRVLN,IBACT,IBCNT,IBJ,DD,DO,DIC,DIE,DA,DR,X,Y
- SET IBCNT=0
- SET IBACT=""
- +2 ;
- +3 SET IBLN=$PIECE($TEXT(FRVA+1),";;",2)
- +4 ;
- +5 FOR IBI=1:1
- SET IBRV=$PIECE(IBLN,",",IBI)
- if IBRV'?3N
- QUIT
- Begin DoDot:1
- +6 ;
- +7 SET IBRVFN=$ORDER(^DGCR(399.2,"B",IBRV,0))
- if 'IBRVFN
- QUIT
- +8 SET IBRVLN=$GET(^DGCR(399.2,+IBRVFN,0))
- if IBRVLN=""
- QUIT
- +9 IF +$PIECE(IBRVLN,U,3)
- QUIT
- +10 ;
- +11 SET IBCNT=IBCNT+1
- SET IBACT=IBACT_IBRV_","
- +12 SET DR="2////1"
- SET DIE="^DGCR(399.2,"
- SET DA=+IBRVFN
- DO ^DIE
- KILL DIE,DIC,DA,DR,X,Y
- End DoDot:1
- +13 ;
- +14 IF IBCNT>0
- SET IBJ=0
- FOR IBI=1:15
- SET IBJ=IBJ+15
- SET IBLN=$PIECE(IBACT,",",IBI,IBJ)
- if IBLN=""
- QUIT
- DO MSG(" "_IBLN)
- +15 ;
- RVAQ SET IBA(1)=" >> "_IBCNT_" Revenue Codes activated (399.2)..."
- DO MSG(" ")
- +1 DO MES^XPDUTL(.IBA)
- +2 QUIT
- +3 ;
- +4 ;
- MSG(X) ;
- +1 NEW IBX
- SET IBX=$ORDER(IBA(999999),-1)
- if 'IBX
- SET IBX=1
- SET IBX=IBX+1
- +2 SET IBA(IBX)=$GET(X)
- +3 QUIT
- +4 ;
- FRVA ; Revenue Codes to Activate (399.2,2)
- +1 ;;900,
- +2 ;;