IB20PT51 ;ALB/CPM - MORE IB V2.0 POST-INIT ONE-TIME ITEMS ; 28-JAN-94
;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
;
; Perform more one-time post-init items
D UBFM ; add UB-92 form type to the Form Type (#353) file
D RXFT ; add Addendum form type to the Form Type (#353) file
D FLAG ; flag telephone stop codes as non-billable
D HOLD ; check all charges 'on hold' in file #350
Q
;
;
UBFM ; Add UB-92 form type to the Form Type (#353) file.
Q:$O(^IBE(353,"B","UB-92",0))
W !!,">>> Adding UB-92 form type to the Form Type (#353) file."
S DINUM=0 F Y=3:1:1000 I '$D(^IBE(353,Y,0))!($P($G(^IBE(353,Y,0)),U,1)="UB-92") S DINUM=Y Q
I 'DINUM W !!,"**** ERROR: Could not add UB-92 claim form to file 353! ****" G UBFMQ
S DIC="^IBE(353,",DIC(0)="LX",X="UB-92" D ^DIC
I '$P(Y,U,3) W !!,"**** ERROR: UB-92 Claim Form already defined! Check Routine. ****" G UBFMQ
I +Y>0 S DA=+Y,DIE=DIC,DR="1.01///^S X=""EN^IBCF3""" D ^DIE
UBFMQ K DIC,DIE,DA,Y,X,DR,DINUM
Q
;
RXFT ; Add Addendum form type to the Form Type (#353) file.
W !!,">>> Adding Addendum form type to the Form Type (#353) file."
S DINUM=0 F Y=3:1:1000 I '$D(^IBE(353,Y,0))!($P($G(^IBE(353,Y,0)),U,1)="BILL ADDENDUM") S DINUM=Y Q
I 'DINUM W !!,"**** ERROR: Could not add BILL ADDENDUM claim form to file 353! ****" G RXFTE
S DIC="^IBE(353,",DIC(0)="LX",X="BILL ADDENDUM" D ^DIC
I '$P(Y,U,3) W !!,"**** ERROR: BILL ADDENDUM Claim Form already defined! Check Routine. ****" G RXFTE
I +Y>0 S DA=+Y,DIE=DIC,DR="1.01///^S X=""EN^IBCF4""" D ^DIE
RXFTE K DIC,DIE,DA,Y,X,DR,DINUM
Q
;
FLAG ; Flag Telephone Stop Codes as non-billable for Means Test Billing
W !!,">>> Flagging Telephone stop codes as non-billable for Means Test Billing..."
F IBI=1:1 S IBS=$P($T(STOPS+IBI),";;",2) Q:IBS="QUIT" D
.S X=$O(^DIC(40.7,"B",IBS,0))
.I 'X W !?4,"Unable to flag the stop code '",IBS,"' (not on file)..." Q
.K DD,DO S DIC="^IBE(352.3,",DIC(0)="" D FILE^DICN Q:Y<0
.S DIE=DIC,DA=+Y,DR=".02////2940201;.03////1" D ^DIE
.W !?4,"Flagged stop code '",IBS,"' as non-billable..."
K DA,DIC,DIE,DR,IBI,IBS,X,Y
Q
;
STOPS ; Stop codes to flag
;;TELEPHONE TRIAGE
;;TELEPHONE/MEDICINE
;;TELEPHONE/SURGERY
;;TELEPHONE/SPECIAL PSYCHIATRY
;;TELEPHONE/GENERAL PSYCHIATRY
;;TELEPHONE/PTSD
;;TELEPHONE/ALCOHOL DEPENDENCE
;;TELEPHONE/DRUG DEPENDENCE
;;TELEPHONE/SUBSTANCE ABUSE
;;TELEPHONE/ANCILLARY
;;TELEPHONE/REHAB AND SUPPORT
;;TELEPHONE/DIAGNOSTIC
;;TELEPHONE/PROSTHETICS/ORTHOTIC
;;TELEPHONE/DENTAL
;;TELEPHONE/DIALYSIS
;;QUIT
;
;
HOLD ; Check all charges in file #350 that are on hold.
;
W !!,">>> Examining all charges 'on hold' in File #350..."
;
S (IBCNTR,IBCNTU)=0
;
; - run through all held charges
S DFN=0 F S DFN=$O(^IB("AH",DFN)) Q:'DFN D
.S IBN=0 F S IBN=$O(^IB("AH",DFN,IBN)) Q:'IBN D
..;
..; - get the action and parent
..S IBND=$G(^IB(IBN,0)),IBPAR=+$P(IBND,"^",9)
..;
..; - if the parent is itself, and there's no entry in
..; - ^ib("apdt",ibpar then re-index entry
..I IBN=IBPAR,'$D(^IB("APDT",IBN)) S DA=IBN,DIK="^IB(" D IX1^DIK S IBCNTR=IBCNTR+1
..;
..; - determine the transaction type of the last transaction
..S IBL=$$LAST^IBECEAU(IBPAR)
..S IBTRTY=$P($G(^IBE(350.1,+$P($G(^IB(IBL,0)),"^",3),0)),"^",5)
..;
..; - if the transaction was a cancel-type transaction, update
..; - the status of the held charge to cancelled.
..Q:IBTRTY'=2
..S DA=IBN,DIE="^IB(",DR=".05////10" D ^DIE
..S IBCNTU=IBCNTU+1
..;
..; - show signs of life
..W:'(IBCNTU#10) "."
;
;
W !," >> ",$S(IBCNTU:IBCNTU,1:"No")," held charge",$S(IBCNTU=1:" was",1:"s were")," updated to cancelled."
W !," >> ",$S(IBCNTR:IBCNTR,1:"No")," held charge",$S(IBCNTR=1:" was",1:"s were")," re-indexed."
;
K DA,DIK,DIE,DR,DFN,IBCNTR,IBCNTU,IBN,IBND,IBPAR,IBL,IBTRTY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20PT51 3871 printed Dec 13, 2024@02:05:21 Page 2
IB20PT51 ;ALB/CPM - MORE IB V2.0 POST-INIT ONE-TIME ITEMS ; 28-JAN-94
+1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
+2 ;
+3 ; Perform more one-time post-init items
+4 ; add UB-92 form type to the Form Type (#353) file
DO UBFM
+5 ; add Addendum form type to the Form Type (#353) file
DO RXFT
+6 ; flag telephone stop codes as non-billable
DO FLAG
+7 ; check all charges 'on hold' in file #350
DO HOLD
+8 QUIT
+9 ;
+10 ;
UBFM ; Add UB-92 form type to the Form Type (#353) file.
+1 if $ORDER(^IBE(353,"B","UB-92",0))
QUIT
+2 WRITE !!,">>> Adding UB-92 form type to the Form Type (#353) file."
+3 SET DINUM=0
FOR Y=3:1:1000
IF '$DATA(^IBE(353,Y,0))!($PIECE($GET(^IBE(353,Y,0)),U,1)="UB-92")
SET DINUM=Y
QUIT
+4 IF 'DINUM
WRITE !!,"**** ERROR: Could not add UB-92 claim form to file 353! ****"
GOTO UBFMQ
+5 SET DIC="^IBE(353,"
SET DIC(0)="LX"
SET X="UB-92"
DO ^DIC
+6 IF '$PIECE(Y,U,3)
WRITE !!,"**** ERROR: UB-92 Claim Form already defined! Check Routine. ****"
GOTO UBFMQ
+7 IF +Y>0
SET DA=+Y
SET DIE=DIC
SET DR="1.01///^S X=""EN^IBCF3"""
DO ^DIE
UBFMQ KILL DIC,DIE,DA,Y,X,DR,DINUM
+1 QUIT
+2 ;
RXFT ; Add Addendum form type to the Form Type (#353) file.
+1 WRITE !!,">>> Adding Addendum form type to the Form Type (#353) file."
+2 SET DINUM=0
FOR Y=3:1:1000
IF '$DATA(^IBE(353,Y,0))!($PIECE($GET(^IBE(353,Y,0)),U,1)="BILL ADDENDUM")
SET DINUM=Y
QUIT
+3 IF 'DINUM
WRITE !!,"**** ERROR: Could not add BILL ADDENDUM claim form to file 353! ****"
GOTO RXFTE
+4 SET DIC="^IBE(353,"
SET DIC(0)="LX"
SET X="BILL ADDENDUM"
DO ^DIC
+5 IF '$PIECE(Y,U,3)
WRITE !!,"**** ERROR: BILL ADDENDUM Claim Form already defined! Check Routine. ****"
GOTO RXFTE
+6 IF +Y>0
SET DA=+Y
SET DIE=DIC
SET DR="1.01///^S X=""EN^IBCF4"""
DO ^DIE
RXFTE KILL DIC,DIE,DA,Y,X,DR,DINUM
+1 QUIT
+2 ;
FLAG ; Flag Telephone Stop Codes as non-billable for Means Test Billing
+1 WRITE !!,">>> Flagging Telephone stop codes as non-billable for Means Test Billing..."
+2 FOR IBI=1:1
SET IBS=$PIECE($TEXT(STOPS+IBI),";;",2)
if IBS="QUIT"
QUIT
Begin DoDot:1
+3 SET X=$ORDER(^DIC(40.7,"B",IBS,0))
+4 IF 'X
WRITE !?4,"Unable to flag the stop code '",IBS,"' (not on file)..."
QUIT
+5 KILL DD,DO
SET DIC="^IBE(352.3,"
SET DIC(0)=""
DO FILE^DICN
if Y<0
QUIT
+6 SET DIE=DIC
SET DA=+Y
SET DR=".02////2940201;.03////1"
DO ^DIE
+7 WRITE !?4,"Flagged stop code '",IBS,"' as non-billable..."
End DoDot:1
+8 KILL DA,DIC,DIE,DR,IBI,IBS,X,Y
+9 QUIT
+10 ;
STOPS ; Stop codes to flag
+1 ;;TELEPHONE TRIAGE
+2 ;;TELEPHONE/MEDICINE
+3 ;;TELEPHONE/SURGERY
+4 ;;TELEPHONE/SPECIAL PSYCHIATRY
+5 ;;TELEPHONE/GENERAL PSYCHIATRY
+6 ;;TELEPHONE/PTSD
+7 ;;TELEPHONE/ALCOHOL DEPENDENCE
+8 ;;TELEPHONE/DRUG DEPENDENCE
+9 ;;TELEPHONE/SUBSTANCE ABUSE
+10 ;;TELEPHONE/ANCILLARY
+11 ;;TELEPHONE/REHAB AND SUPPORT
+12 ;;TELEPHONE/DIAGNOSTIC
+13 ;;TELEPHONE/PROSTHETICS/ORTHOTIC
+14 ;;TELEPHONE/DENTAL
+15 ;;TELEPHONE/DIALYSIS
+16 ;;QUIT
+17 ;
+18 ;
HOLD ; Check all charges in file #350 that are on hold.
+1 ;
+2 WRITE !!,">>> Examining all charges 'on hold' in File #350..."
+3 ;
+4 SET (IBCNTR,IBCNTU)=0
+5 ;
+6 ; - run through all held charges
+7 SET DFN=0
FOR
SET DFN=$ORDER(^IB("AH",DFN))
if 'DFN
QUIT
Begin DoDot:1
+8 SET IBN=0
FOR
SET IBN=$ORDER(^IB("AH",DFN,IBN))
if 'IBN
QUIT
Begin DoDot:2
+9 ;
+10 ; - get the action and parent
+11 SET IBND=$GET(^IB(IBN,0))
SET IBPAR=+$PIECE(IBND,"^",9)
+12 ;
+13 ; - if the parent is itself, and there's no entry in
+14 ; - ^ib("apdt",ibpar then re-index entry
+15 IF IBN=IBPAR
IF '$DATA(^IB("APDT",IBN))
SET DA=IBN
SET DIK="^IB("
DO IX1^DIK
SET IBCNTR=IBCNTR+1
+16 ;
+17 ; - determine the transaction type of the last transaction
+18 SET IBL=$$LAST^IBECEAU(IBPAR)
+19 SET IBTRTY=$PIECE($GET(^IBE(350.1,+$PIECE($GET(^IB(IBL,0)),"^",3),0)),"^",5)
+20 ;
+21 ; - if the transaction was a cancel-type transaction, update
+22 ; - the status of the held charge to cancelled.
+23 if IBTRTY'=2
QUIT
+24 SET DA=IBN
SET DIE="^IB("
SET DR=".05////10"
DO ^DIE
+25 SET IBCNTU=IBCNTU+1
+26 ;
+27 ; - show signs of life
+28 if '(IBCNTU#10)
WRITE "."
End DoDot:2
End DoDot:1
+29 ;
+30 ;
+31 WRITE !," >> ",$SELECT(IBCNTU:IBCNTU,1:"No")," held charge",$SELECT(IBCNTU=1:" was",1:"s were")," updated to cancelled."
+32 WRITE !," >> ",$SELECT(IBCNTR:IBCNTR,1:"No")," held charge",$SELECT(IBCNTR=1:" was",1:"s were")," re-indexed."
+33 ;
+34 KILL DA,DIK,DIE,DR,DFN,IBCNTR,IBCNTU,IBN,IBND,IBPAR,IBL,IBTRTY
+35 QUIT
