- 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 Feb 18, 2025@23:07:08 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 ;