PRCAP421 ;EDE/LLB - PRCA*4.5*421 POST INSTALL;05/25/23 2:10pm
;;4.5;Accounts Receivable;**421**;Mar 20, 1995;Build 10
;Per VA Directive 6402, this routine should not be modified.
POSTINIT ;Post Install for PRCA*4.5*421
D BMES^XPDUTL(" >> Starting the Post-Initialization routine for PRCA*4.5*421")
; Updating AR CATEGORIES foand REVENUE SOURCE CODES
D ARCATUPD
D BMES^XPDUTL(" >> End of the Post-Initialization routine for PRCA*4.5*421")
Q
;
ARCATUPD ; Initialize the new DISPLAY IN TRANS PROFILE? field in the AR Category file.
;
N LOOP,LIEN,IBDATA
N X,Y,DIE,DA,DR,DTOUT,RCDATA,RCNM,RCTOP,RCCS
;
; Grab all of the entries to update
F LOOP=1:1 S RCDATA=$T(ARDAT+LOOP) Q:$P(RCDATA,";",3)="END" D
. ;Extract the new ACTION TYPE to be added.
. S RCDATA=$P(RCDATA,";;",2)
. S RCNM=$P(RCDATA,";",1)
. S RCTOP=$P(RCDATA,";",2),RCCS=$P(RCDATA,";",3)
. S LIEN=$O(^PRCA(430.2,"B",RCNM,"")) ; find CHARGE REMOVE REASON entry
. Q:LIEN=""
. ;
. ; File the update along with inactivate the ACTION TYPE
. S DR="1.01///"_1
. S DR=DR_";1.02///"_RCTOP
. S DR=DR_";1.03///"_RCCS
. S DIE="^PRCA(430.2,",DA=LIEN
. D ^DIE
. K DR ;Clear update array before next use
;
S DR=""
D MES^XPDUTL(" -> Updated the REFER TO CS?, REFER TO TOP?, and REFER TO DMC? fields in the AR Category (430.2) file.")
Q
;
ARDAT ; Cancellation reasons (350.3) to update
;;EMERGENCY/HUMANITARIAN;4;5
;;INELIGIBLE HOSP.;4;5
;;END
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAP421 1469 printed Aug 26, 2025@21:56:43 Page 2
PRCAP421 ;EDE/LLB - PRCA*4.5*421 POST INSTALL;05/25/23 2:10pm
+1 ;;4.5;Accounts Receivable;**421**;Mar 20, 1995;Build 10
+2 ;Per VA Directive 6402, this routine should not be modified.
POSTINIT ;Post Install for PRCA*4.5*421
+1 DO BMES^XPDUTL(" >> Starting the Post-Initialization routine for PRCA*4.5*421")
+2 ; Updating AR CATEGORIES foand REVENUE SOURCE CODES
+3 DO ARCATUPD
+4 DO BMES^XPDUTL(" >> End of the Post-Initialization routine for PRCA*4.5*421")
+5 QUIT
+6 ;
ARCATUPD ; Initialize the new DISPLAY IN TRANS PROFILE? field in the AR Category file.
+1 ;
+2 NEW LOOP,LIEN,IBDATA
+3 NEW X,Y,DIE,DA,DR,DTOUT,RCDATA,RCNM,RCTOP,RCCS
+4 ;
+5 ; Grab all of the entries to update
+6 FOR LOOP=1:1
SET RCDATA=$TEXT(ARDAT+LOOP)
if $PIECE(RCDATA,";",3)="END"
QUIT
Begin DoDot:1
+7 ;Extract the new ACTION TYPE to be added.
+8 SET RCDATA=$PIECE(RCDATA,";;",2)
+9 SET RCNM=$PIECE(RCDATA,";",1)
+10 SET RCTOP=$PIECE(RCDATA,";",2)
SET RCCS=$PIECE(RCDATA,";",3)
+11 ; find CHARGE REMOVE REASON entry
SET LIEN=$ORDER(^PRCA(430.2,"B",RCNM,""))
+12 if LIEN=""
QUIT
+13 ;
+14 ; File the update along with inactivate the ACTION TYPE
+15 SET DR="1.01///"_1
+16 SET DR=DR_";1.02///"_RCTOP
+17 SET DR=DR_";1.03///"_RCCS
+18 SET DIE="^PRCA(430.2,"
SET DA=LIEN
+19 DO ^DIE
+20 ;Clear update array before next use
KILL DR
End DoDot:1
+21 ;
+22 SET DR=""
+23 DO MES^XPDUTL(" -> Updated the REFER TO CS?, REFER TO TOP?, and REFER TO DMC? fields in the AR Category (430.2) file.")
+24 QUIT
+25 ;
ARDAT ; Cancellation reasons (350.3) to update
+1 ;;EMERGENCY/HUMANITARIAN;4;5
+2 ;;INELIGIBLE HOSP.;4;5
+3 ;;END
