PRCAP365 ;SAB/Albany - PRCA*4.5*338 POST INSTALL;3/10/20 8:10am
;;4.5;Accounts Receivable;**365**;Mar 20, 1995;Build 6
;Per VA Directive 6402, this routine should not be modified.
Q
;
POSTINIT ;Post Install for IB*2.0*669
D BMES^XPDUTL(" >> Starting the Post-Initialization routine for IB*2.0*669")
; Adding AR CATEGORIES and REVENUE SOURCE CODES
D ARCATUPD
D BMES^XPDUTL(" >> End of the Post-Initialization routine for IB*2.0*669")
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,DATA
;
; Grab all of the entries to update
F LOOP=1:1:21 D
. ;Extract the new ACTION TYPE to be added.
. S RCDATA=$T(ARDAT+LOOP)
. S RCDATA=$P(RCDATA,";;",2)
. S RCNM=$P(RCDATA,";",1),RCFLG=$P(RCDATA,";",2)
. 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.04///"_RCFLG
. S DIE="^PRCA(430.2,",DA=LIEN
. D ^DIE
. K DR ;Clear update array before next use
;
S DR=""
D MES^XPDUTL(" -> Updated the DISPLAY IN TRANS PROFILE field in the AR Category (430.3) file.")
Q
;
ARDAT ; Cancellation reasons (350.3) to update
;;C (MEANS TEST);4
;;HOSPITAL CARE (NSC);4
;;HOSPITAL CARE PER DIEM;4
;;NURSING HOME CARE PER DIEM;3
;;NURSING HOME CARE(NSC);3
;;OUTPATIENT CARE(NSC);2
;;RX CO-PAYMENT/NSC VET;1
;;RX CO-PAYMENT/SC VET;1
;;CHOICE INPT;4
;;CHOICE OPT;2
;;CHOICE RX CO-PAYMENT;5
;;CC INPT;4
;;CC OPT;2
;;CC RX CO-PAYMENT;5
;;CCN INPT;4
;;CCN OPT;2
;;CCN RX CO-PAYMENT;5
;;CC MTF INPT;4
;;CC MTF OPT;2
;;CC MTF RX CO-PAYMENT;5
;;CC URGENT CARE;2
;;END
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAP365 1743 printed Dec 13, 2024@01:40:44 Page 2
PRCAP365 ;SAB/Albany - PRCA*4.5*338 POST INSTALL;3/10/20 8:10am
+1 ;;4.5;Accounts Receivable;**365**;Mar 20, 1995;Build 6
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
POSTINIT ;Post Install for IB*2.0*669
+1 DO BMES^XPDUTL(" >> Starting the Post-Initialization routine for IB*2.0*669")
+2 ; Adding AR CATEGORIES and REVENUE SOURCE CODES
+3 DO ARCATUPD
+4 DO BMES^XPDUTL(" >> End of the Post-Initialization routine for IB*2.0*669")
+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,DATA
+4 ;
+5 ; Grab all of the entries to update
+6 FOR LOOP=1:1:21
Begin DoDot:1
+7 ;Extract the new ACTION TYPE to be added.
+8 SET RCDATA=$TEXT(ARDAT+LOOP)
+9 SET RCDATA=$PIECE(RCDATA,";;",2)
+10 SET RCNM=$PIECE(RCDATA,";",1)
SET RCFLG=$PIECE(RCDATA,";",2)
+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.04///"_RCFLG
+16 SET DIE="^PRCA(430.2,"
SET DA=LIEN
+17 DO ^DIE
+18 ;Clear update array before next use
KILL DR
End DoDot:1
+19 ;
+20 SET DR=""
+21 DO MES^XPDUTL(" -> Updated the DISPLAY IN TRANS PROFILE field in the AR Category (430.3) file.")
+22 QUIT
+23 ;
ARDAT ; Cancellation reasons (350.3) to update
+1 ;;C (MEANS TEST);4
+2 ;;HOSPITAL CARE (NSC);4
+3 ;;HOSPITAL CARE PER DIEM;4
+4 ;;NURSING HOME CARE PER DIEM;3
+5 ;;NURSING HOME CARE(NSC);3
+6 ;;OUTPATIENT CARE(NSC);2
+7 ;;RX CO-PAYMENT/NSC VET;1
+8 ;;RX CO-PAYMENT/SC VET;1
+9 ;;CHOICE INPT;4
+10 ;;CHOICE OPT;2
+11 ;;CHOICE RX CO-PAYMENT;5
+12 ;;CC INPT;4
+13 ;;CC OPT;2
+14 ;;CC RX CO-PAYMENT;5
+15 ;;CCN INPT;4
+16 ;;CCN OPT;2
+17 ;;CCN RX CO-PAYMENT;5
+18 ;;CC MTF INPT;4
+19 ;;CC MTF OPT;2
+20 ;;CC MTF RX CO-PAYMENT;5
+21 ;;CC URGENT CARE;2
+22 ;;END
+23 ;
