- PRCAP360 ;SAB/Albany - PRCA*4.5*360 POST INSTALL;07/30/19 2:10pm
- ;;4.5;Accounts Receivable;**360**;Mar 20, 1995;Build 10
- ;Per VA Directive 6402, this routine should not be modified.
- Q
- ;
- POSTINIT ;Post Install for PRCA*4.5*360
- D BMES^XPDUTL(" >> Starting the Post-Initialization routine for PRCA*4.5*360 ")
- ; Adding AR CATEGORY
- D ARCAT
- ; rebuild cross-references
- D BMES^XPDUTL(" >> End of the Post-Initialization routine for PRCA*4.5*360")
- Q
- ;
- ARCAT ;AR CATEGORY ENTRY (430.2)
- N LOOP,FDA,FDAIEN,DATA,CHKIEN,NUM,NEWREC,SEMI2
- N DA,DIE,DLAYGO,DR,FUND,X,Y
- ;
- D MES^XPDUTL(" -> Adding new AR CATEGORY entries to file 430.2 ...")
- ; Add new AR categories
- S SEMI2=2 ; Two semicolons";;" counted for each field
- F LOOP=2:1 S DATA=$T(ARDATA+LOOP) Q:$P(DATA,";",3)="END" D
- .S NEWREC=1 ; New record indicator
- .;Extract the new AR Category to be added.
- .;Check to insure that the AR Category doesn't exist already
- .S CHKIEN="" ; Initialized the check variable
- .S CHKIEN=$O(^PRCA(430.2,"B",$P(DATA,";",3),"")) ; Category Name (UNEDITABLE)
- .I +CHKIEN S NEWREC=0 D MES^XPDUTL($P(DATA,";",3)_" already exist and updating...")
- . K DD,DO,Y
- . S DLAYGO=430.2,DIC="^PRCA(430.2,",DIC(0)="L",X=$P(DATA,";",3)
- . ;
- . ; If no entry found, create a new entry
- . I '+CHKIEN D FILE^DICN S CHKIEN=+Y K DIC,DINUM,DLAYGO
- . ;
- .S DR=""
- .; Field# | Name of field
- .S:NEWREC=1 DR="1///"_$P(DATA,";",2+SEMI2) ; 1 | Abbreviation (UNEDITABLE)
- .S DR=DR_";2///"_$P(DATA,";",3+SEMI2) ; 2 | AMIS Seg # (UNEDITABLE)
- .S DR=DR_";3///"_$P(DATA,";",4+SEMI2) ; 3 | GL Number
- .S DR=DR_";5///"_$P(DATA,";",5+SEMI2) ; 5 | Type (P,O,T,V,C,N)
- .S:NEWREC=1 DR=DR_";6////"_$P(DATA,";",6+SEMI2) ; 6 | Category number (UNEDITABLE)
- .S DR=DR_";7///"_$P(DATA,";",7+SEMI2) ; 7 | Receivable Code
- .S DR=DR_";9///"_$P(DATA,";",11+SEMI2) ; 9 | Interest
- .S DR=DR_";10///"_$P(DATA,";",9+SEMI2) ;10 | Admin
- .S DR=DR_";11///"_$P(DATA,";",10+SEMI2) ;11 | Penalty
- .S:NEWREC=1 DR=DR_";12///"_$P(DATA,";",11+SEMI2) ;12 | Accrued (UNEDITABLE)
- .S DR=DR_";13///"_$P(DATA,";",12+SEMI2) ;13 | Refund
- .S DR=DR_";14///"_$P(DATA,";",13+SEMI2) ;14 | Paragraph Codes
- .; REFERRALS
- .S DR=DR_";1.01///1;" ;1.01 | Refer to DMC?
- .S DR=DR_"1.02///2;" ;1.02 | Refer to TOP?
- .S DR=DR_"1.03///3" ;1.03 | Refer to CS?
- .;
- .I $E(DR,1)=";" S DR=$P(DR,";",2,$L(DR)) ; Remove ";" to update existing record with data specified in fields
- .;
- .S DIE="^PRCA(430.2,",DA=CHKIEN
- .D ^DIE
- S DA=CHKIEN,DIK="^IBE(430.2," D IX^DIK ; Re-Index
- D MES^XPDUTL(" New AR CATEGORY added.")
- Q
- ; ACTUAL FIELD SETTINGS NEXT LINE
- ;;CC URGENT CARE;U1;240;1221;P;87;2;1;1;0;1;2;30,40,55,80,85,50,60,65,70
- ;
- ; field 1 2 3 4 5 6 7 8 9 10111213
- ARDATA ; New AR Category data. (Internal data format)
- ;;Category Name;Abbreviation;AMIS Seg #;GL Number;Type;AR Cat #;Receivable Code;Interest;Admin;Penalty;Accrued;Refund;Paragraph Codes
- ;;CC URGENT CARE;U1;240;1221;P;87;2;1;1;0;1;2;30,40,55,80,85,50,60,65,70
- ;;END
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRCAP360 3381 printed Jan 18, 2025@02:41:57 Page 2
- PRCAP360 ;SAB/Albany - PRCA*4.5*360 POST INSTALL;07/30/19 2:10pm
- +1 ;;4.5;Accounts Receivable;**360**;Mar 20, 1995;Build 10
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 QUIT
- +4 ;
- POSTINIT ;Post Install for PRCA*4.5*360
- +1 DO BMES^XPDUTL(" >> Starting the Post-Initialization routine for PRCA*4.5*360 ")
- +2 ; Adding AR CATEGORY
- +3 DO ARCAT
- +4 ; rebuild cross-references
- +5 DO BMES^XPDUTL(" >> End of the Post-Initialization routine for PRCA*4.5*360")
- +6 QUIT
- +7 ;
- ARCAT ;AR CATEGORY ENTRY (430.2)
- +1 NEW LOOP,FDA,FDAIEN,DATA,CHKIEN,NUM,NEWREC,SEMI2
- +2 NEW DA,DIE,DLAYGO,DR,FUND,X,Y
- +3 ;
- +4 DO MES^XPDUTL(" -> Adding new AR CATEGORY entries to file 430.2 ...")
- +5 ; Add new AR categories
- +6 ; Two semicolons";;" counted for each field
- SET SEMI2=2
- +7 FOR LOOP=2:1
- SET DATA=$TEXT(ARDATA+LOOP)
- if $PIECE(DATA,";",3)="END"
- QUIT
- Begin DoDot:1
- +8 ; New record indicator
- SET NEWREC=1
- +9 ;Extract the new AR Category to be added.
- +10 ;Check to insure that the AR Category doesn't exist already
- +11 ; Initialized the check variable
- SET CHKIEN=""
- +12 ; Category Name (UNEDITABLE)
- SET CHKIEN=$ORDER(^PRCA(430.2,"B",$PIECE(DATA,";",3),""))
- +13 IF +CHKIEN
- SET NEWREC=0
- DO MES^XPDUTL($PIECE(DATA,";",3)_" already exist and updating...")
- +14 KILL DD,DO,Y
- +15 SET DLAYGO=430.2
- SET DIC="^PRCA(430.2,"
- SET DIC(0)="L"
- SET X=$PIECE(DATA,";",3)
- +16 ;
- +17 ; If no entry found, create a new entry
- +18 IF '+CHKIEN
- DO FILE^DICN
- SET CHKIEN=+Y
- KILL DIC,DINUM,DLAYGO
- +19 ;
- +20 SET DR=""
- +21 ; Field# | Name of field
- +22 ; 1 | Abbreviation (UNEDITABLE)
- if NEWREC=1
- SET DR="1///"_$PIECE(DATA,";",2+SEMI2)
- +23 ; 2 | AMIS Seg # (UNEDITABLE)
- SET DR=DR_";2///"_$PIECE(DATA,";",3+SEMI2)
- +24 ; 3 | GL Number
- SET DR=DR_";3///"_$PIECE(DATA,";",4+SEMI2)
- +25 ; 5 | Type (P,O,T,V,C,N)
- SET DR=DR_";5///"_$PIECE(DATA,";",5+SEMI2)
- +26 ; 6 | Category number (UNEDITABLE)
- if NEWREC=1
- SET DR=DR_";6////"_$PIECE(DATA,";",6+SEMI2)
- +27 ; 7 | Receivable Code
- SET DR=DR_";7///"_$PIECE(DATA,";",7+SEMI2)
- +28 ; 9 | Interest
- SET DR=DR_";9///"_$PIECE(DATA,";",11+SEMI2)
- +29 ;10 | Admin
- SET DR=DR_";10///"_$PIECE(DATA,";",9+SEMI2)
- +30 ;11 | Penalty
- SET DR=DR_";11///"_$PIECE(DATA,";",10+SEMI2)
- +31 ;12 | Accrued (UNEDITABLE)
- if NEWREC=1
- SET DR=DR_";12///"_$PIECE(DATA,";",11+SEMI2)
- +32 ;13 | Refund
- SET DR=DR_";13///"_$PIECE(DATA,";",12+SEMI2)
- +33 ;14 | Paragraph Codes
- SET DR=DR_";14///"_$PIECE(DATA,";",13+SEMI2)
- +34 ; REFERRALS
- +35 ;1.01 | Refer to DMC?
- SET DR=DR_";1.01///1;"
- +36 ;1.02 | Refer to TOP?
- SET DR=DR_"1.02///2;"
- +37 ;1.03 | Refer to CS?
- SET DR=DR_"1.03///3"
- +38 ;
- +39 ; Remove ";" to update existing record with data specified in fields
- IF $EXTRACT(DR,1)=";"
- SET DR=$PIECE(DR,";",2,$LENGTH(DR))
- +40 ;
- +41 SET DIE="^PRCA(430.2,"
- SET DA=CHKIEN
- +42 DO ^DIE
- End DoDot:1
- +43 ; Re-Index
- SET DA=CHKIEN
- SET DIK="^IBE(430.2,"
- DO IX^DIK
- +44 DO MES^XPDUTL(" New AR CATEGORY added.")
- +45 QUIT
- +46 ; ACTUAL FIELD SETTINGS NEXT LINE
- +47 ;;CC URGENT CARE;U1;240;1221;P;87;2;1;1;0;1;2;30,40,55,80,85,50,60,65,70
- +48 ;
- +49 ; field 1 2 3 4 5 6 7 8 9 10111213
- ARDATA ; New AR Category data. (Internal data format)
- +1 ;;Category Name;Abbreviation;AMIS Seg #;GL Number;Type;AR Cat #;Receivable Code;Interest;Admin;Penalty;Accrued;Refund;Paragraph Codes
- +2 ;;CC URGENT CARE;U1;240;1221;P;87;2;1;1;0;1;2;30,40,55,80,85,50,60,65,70
- +3 ;;END