IBYJPT ;ALB/ARH - PATCH IB*2*55 POST - INITIALIZATION ; 1-AUG-95
;;Version 2.0 ; INTEGRATED BILLING ;**55**; 21-MAR-94
;
EN ; Patch IB*2*55 post initialization.
;
D RNB ; Add new reason not billable for non-billable clinics (356.8)
D FLAG ; Set PROGRAM flag on existing stop and clinic entries (352.3,352.4)
D NBSTOP ; Add entries for TP non-billable stops (352.3)
D BMES^XPDUTL(" Post-Install Complete")
Q
;
;
RNB ; Add to CLAIMS TRACKING NON-BILLABLE REASONS (356.8) a reason of NON-BILLABLE CLINIC
N IBI,DINUM,DIC,Y
I $D(^IBE(356.8,"B","NON-BILLABLE CLINIC")) D BMES^XPDUTL(" *** REASON NOT BILLABLE of 'NON-BILLABLE CLINIC' already exists in FILE #356.8, new entry NOT added.") Q
D BMES^XPDUTL(" <<< Adding new REASON NOT BILLABLE of 'NON-BILLABLE CLINIC' to file #356.8")
F IBI=19:1:999 I '$D(^IBE(356.8,IBI,0)) D Q
. S DINUM=IBI I '$D(^IBE(356.8,DINUM,0)) K DD,DO S DIC="^IBE(356.8,",DIC(0)="L",X="NON-BILLABLE CLINIC" D FILE^DICN
I $G(Y)<1 D BMES^XPDUTL(" **** Unable to add new entry to FILE #356.8, contact Field Support ****")
K DIC,DINUM,Y,DD,DO
Q
;
FLAG ; insert program flag into existing entries in the two files
;
; add flag to clinic stops (352.3)
D BMES^XPDUTL(" <<< Updating entries in NON-BILLABLE CLINIC STOP CODES (#352.3) file ")
N IBI,IBX,DIE,DA,DR
S IBI=0 F S IBI=$O(^IBE(352.3,IBI)) Q:'IBI D
. S IBX=$G(^IBE(352.3,IBI,0)) I +$P(IBX,U,4) Q
. S DIE="^IBE(352.3,",DA=IBI,DR=".04////1" D ^DIE K DIE,DA,DR
;
; add flag to clinic (352.4)
D BMES^XPDUTL(" <<< Updating entries in NON-BILLABLE CLINICS (#352.4) file ")
K IBI,IBX,DIE,DA,DR
S IBI=0 F S IBI=$O(^IBE(352.4,IBI)) Q:'IBI D
. S IBX=$G(^IBE(352.4,IBI,0)) I +$P(IBX,U,4) Q
. S DIE="^IBE(352.4,",DA=IBI,DR=".04////1" D ^DIE K DIE,DA,DR
Q
;
NBSTOP ; add entries for Third Party Non-Billable Stop Codes to NON-BILLABLE CLINIC STOP CODES (#352.3) file
; Since the MT non-billable flag has been used as a TP non-billable flag, duplicating all MT entries
; that exist for TP will result in the no change in the function
;
D BMES^XPDUTL(" <<< Adding TP Non-billable Stops to NON-BILLABLE CLINIC STOP CODES (#352.3) file ")
N IBI,IBX,IBY,X
S IBI=0 F S IBI=$O(^IBE(352.3,IBI)) Q:'IBI D
. S IBX=$G(^IBE(352.3,IBI,0)) I $P(IBX,U,4)>1 Q
. K DD,DO S IBY=$P($G(^DIC(40.7,+IBX,0)),U,1) I IBY="" Q
. I $D(^IBE(352.3,"AIVDTT2",+IBX,-$P(IBX,U,2))) Q
. S DIC="^IBE(352.3,",DIC(0)="L",X=+IBX D FILE^DICN I Y<1 D BMES^XPDUTL(" *** Could not add entry "_IBI) Q
. S DIE="^IBE(352.3,",DA=+Y,DR=".02////"_$P(IBX,U,2)_";.04////2;.05////"_$P(IBX,U,3) D ^DIE K DIC,X,DIE,DA,DR
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBYJPT 2655 printed Apr 09, 2024@21:06:22 Page 2
IBYJPT ;ALB/ARH - PATCH IB*2*55 POST - INITIALIZATION ; 1-AUG-95
+1 ;;Version 2.0 ; INTEGRATED BILLING ;**55**; 21-MAR-94
+2 ;
EN ; Patch IB*2*55 post initialization.
+1 ;
+2 ; Add new reason not billable for non-billable clinics (356.8)
DO RNB
+3 ; Set PROGRAM flag on existing stop and clinic entries (352.3,352.4)
DO FLAG
+4 ; Add entries for TP non-billable stops (352.3)
DO NBSTOP
+5 DO BMES^XPDUTL(" Post-Install Complete")
+6 QUIT
+7 ;
+8 ;
RNB ; Add to CLAIMS TRACKING NON-BILLABLE REASONS (356.8) a reason of NON-BILLABLE CLINIC
+1 NEW IBI,DINUM,DIC,Y
+2 IF $DATA(^IBE(356.8,"B","NON-BILLABLE CLINIC"))
DO BMES^XPDUTL(" *** REASON NOT BILLABLE of 'NON-BILLABLE CLINIC' already exists in FILE #356.8, new entry NOT added.")
QUIT
+3 DO BMES^XPDUTL(" <<< Adding new REASON NOT BILLABLE of 'NON-BILLABLE CLINIC' to file #356.8")
+4 FOR IBI=19:1:999
IF '$DATA(^IBE(356.8,IBI,0))
Begin DoDot:1
+5 SET DINUM=IBI
IF '$DATA(^IBE(356.8,DINUM,0))
KILL DD,DO
SET DIC="^IBE(356.8,"
SET DIC(0)="L"
SET X="NON-BILLABLE CLINIC"
DO FILE^DICN
End DoDot:1
QUIT
+6 IF $GET(Y)<1
DO BMES^XPDUTL(" **** Unable to add new entry to FILE #356.8, contact Field Support ****")
+7 KILL DIC,DINUM,Y,DD,DO
+8 QUIT
+9 ;
FLAG ; insert program flag into existing entries in the two files
+1 ;
+2 ; add flag to clinic stops (352.3)
+3 DO BMES^XPDUTL(" <<< Updating entries in NON-BILLABLE CLINIC STOP CODES (#352.3) file ")
+4 NEW IBI,IBX,DIE,DA,DR
+5 SET IBI=0
FOR
SET IBI=$ORDER(^IBE(352.3,IBI))
if 'IBI
QUIT
Begin DoDot:1
+6 SET IBX=$GET(^IBE(352.3,IBI,0))
IF +$PIECE(IBX,U,4)
QUIT
+7 SET DIE="^IBE(352.3,"
SET DA=IBI
SET DR=".04////1"
DO ^DIE
KILL DIE,DA,DR
End DoDot:1
+8 ;
+9 ; add flag to clinic (352.4)
+10 DO BMES^XPDUTL(" <<< Updating entries in NON-BILLABLE CLINICS (#352.4) file ")
+11 KILL IBI,IBX,DIE,DA,DR
+12 SET IBI=0
FOR
SET IBI=$ORDER(^IBE(352.4,IBI))
if 'IBI
QUIT
Begin DoDot:1
+13 SET IBX=$GET(^IBE(352.4,IBI,0))
IF +$PIECE(IBX,U,4)
QUIT
+14 SET DIE="^IBE(352.4,"
SET DA=IBI
SET DR=".04////1"
DO ^DIE
KILL DIE,DA,DR
End DoDot:1
+15 QUIT
+16 ;
NBSTOP ; add entries for Third Party Non-Billable Stop Codes to NON-BILLABLE CLINIC STOP CODES (#352.3) file
+1 ; Since the MT non-billable flag has been used as a TP non-billable flag, duplicating all MT entries
+2 ; that exist for TP will result in the no change in the function
+3 ;
+4 DO BMES^XPDUTL(" <<< Adding TP Non-billable Stops to NON-BILLABLE CLINIC STOP CODES (#352.3) file ")
+5 NEW IBI,IBX,IBY,X
+6 SET IBI=0
FOR
SET IBI=$ORDER(^IBE(352.3,IBI))
if 'IBI
QUIT
Begin DoDot:1
+7 SET IBX=$GET(^IBE(352.3,IBI,0))
IF $PIECE(IBX,U,4)>1
QUIT
+8 KILL DD,DO
SET IBY=$PIECE($GET(^DIC(40.7,+IBX,0)),U,1)
IF IBY=""
QUIT
+9 IF $DATA(^IBE(352.3,"AIVDTT2",+IBX,-$PIECE(IBX,U,2)))
QUIT
+10 SET DIC="^IBE(352.3,"
SET DIC(0)="L"
SET X=+IBX
DO FILE^DICN
IF Y<1
DO BMES^XPDUTL(" *** Could not add entry "_IBI)
QUIT
+11 SET DIE="^IBE(352.3,"
SET DA=+Y
SET DR=".02////"_$PIECE(IBX,U,2)_";.04////2;.05////"_$PIECE(IBX,U,3)
DO ^DIE
KILL DIC,X,DIE,DA,DR
End DoDot:1
+12 QUIT
