PRCA280 ;ALB/CXW - POST INIT, Type of Care correction; 14-SEP-2011
;;4.5;Accounts Receivable;**280**;Mar 20, 1995;Build 12
;;Per VHA Directive 10-93-142, this routine should not be modified.
Q
;
POST ;
D MSG(" PRCA*4.5*280 Post-Install .....")
D UPACT
D MSG(" PRCA*4.5*280 Post-Install Complete")
D MSG("")
Q
;
UPACT ;Update to Type of Care #15.1 in file #430
N IBI,IBDG,IBAT,IBAIEN,IBCEN,IBNCC,PRCAX,PRCATC,PRCACNT,DIE,DA,DR,X
S IBNCC="HOSPITAL CARE (NSC)"
S IBCEN=$O(^PRCA(430.2,"B",IBNCC,0))
I 'IBCEN D MSG(">>> "_IBNCC_" not defined on file #430.2, no update on file #430") Q
; update if patient charges in these type events
S IBDG="^DG FEE SERVICE (INPT) CANCEL^DG FEE SERVICE (INPT) NEW^DG FEE SERVICE (INPT) UPDATE^"
;
D MSG(">>> Updating Type of Care to file #430...")
S IBI="",PRCACNT=0
F S IBI=$O(^IB("ABIL",IBI)) Q:IBI="" D
. S IBAIEN=$O(^IB("ABIL",IBI,0)) Q:'IBAIEN
. S IBAT=$P($G(^IB(IBAIEN,0)),"^",3) Q:'IBAT
. S IBAT=$P(^IBE(350.1,IBAT,0),"^")
. ; no update if none of 3 dg fee service (inpt)
. I '$F(IBDG,"^"_IBAT_"^") Q
. S PRCAX=$O(^PRCA(430,"B",IBI,0)) Q:'PRCAX
. S PRCATC=$P(^PRCA(430,PRCAX,0),"^",16)
. ; no update if exists or null
. I ('PRCATC)!(PRCATC=IBCEN) Q
. S PRCATC=$P(^PRCA(430.2,PRCATC,0),"^")
. S DA=+PRCAX,DIE="^PRCA(430,",DR="15.1///"_IBCEN D ^DIE K DA,DIE,DR
. D MSG(" >> "_PRCATC_" on "_IBI_" changed to "_IBNCC)
. S PRCACNT=PRCACNT+1
D MSG(">>> The type of care on total "_PRCACNT_$S(PRCACNT=1:" bill has",1:" bills have")_" been updated")
Q
;
MSG(X) ;
D MES^XPDUTL(X)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCA280 1602 printed Dec 13, 2024@01:38:39 Page 2
PRCA280 ;ALB/CXW - POST INIT, Type of Care correction; 14-SEP-2011
+1 ;;4.5;Accounts Receivable;**280**;Mar 20, 1995;Build 12
+2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
+3 QUIT
+4 ;
POST ;
+1 DO MSG(" PRCA*4.5*280 Post-Install .....")
+2 DO UPACT
+3 DO MSG(" PRCA*4.5*280 Post-Install Complete")
+4 DO MSG("")
+5 QUIT
+6 ;
UPACT ;Update to Type of Care #15.1 in file #430
+1 NEW IBI,IBDG,IBAT,IBAIEN,IBCEN,IBNCC,PRCAX,PRCATC,PRCACNT,DIE,DA,DR,X
+2 SET IBNCC="HOSPITAL CARE (NSC)"
+3 SET IBCEN=$ORDER(^PRCA(430.2,"B",IBNCC,0))
+4 IF 'IBCEN
DO MSG(">>> "_IBNCC_" not defined on file #430.2, no update on file #430")
QUIT
+5 ; update if patient charges in these type events
+6 SET IBDG="^DG FEE SERVICE (INPT) CANCEL^DG FEE SERVICE (INPT) NEW^DG FEE SERVICE (INPT) UPDATE^"
+7 ;
+8 DO MSG(">>> Updating Type of Care to file #430...")
+9 SET IBI=""
SET PRCACNT=0
+10 FOR
SET IBI=$ORDER(^IB("ABIL",IBI))
if IBI=""
QUIT
Begin DoDot:1
+11 SET IBAIEN=$ORDER(^IB("ABIL",IBI,0))
if 'IBAIEN
QUIT
+12 SET IBAT=$PIECE($GET(^IB(IBAIEN,0)),"^",3)
if 'IBAT
QUIT
+13 SET IBAT=$PIECE(^IBE(350.1,IBAT,0),"^")
+14 ; no update if none of 3 dg fee service (inpt)
+15 IF '$FIND(IBDG,"^"_IBAT_"^")
QUIT
+16 SET PRCAX=$ORDER(^PRCA(430,"B",IBI,0))
if 'PRCAX
QUIT
+17 SET PRCATC=$PIECE(^PRCA(430,PRCAX,0),"^",16)
+18 ; no update if exists or null
+19 IF ('PRCATC)!(PRCATC=IBCEN)
QUIT
+20 SET PRCATC=$PIECE(^PRCA(430.2,PRCATC,0),"^")
+21 SET DA=+PRCAX
SET DIE="^PRCA(430,"
SET DR="15.1///"_IBCEN
DO ^DIE
KILL DA,DIE,DR
+22 DO MSG(" >> "_PRCATC_" on "_IBI_" changed to "_IBNCC)
+23 SET PRCACNT=PRCACNT+1
End DoDot:1
+24 DO MSG(">>> The type of care on total "_PRCACNT_$SELECT(PRCACNT=1:" bill has",1:" bills have")_" been updated")
+25 QUIT
+26 ;
MSG(X) ;
+1 DO MES^XPDUTL(X)
+2 QUIT
+3 ;
