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