Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCAP360

PRCAP360.m

Go to the documentation of this file.
  1. 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
  1. ;Per VA Directive 6402, this routine should not be modified.
  1. Q
  1. ;
  1. POSTINIT ;Post Install for PRCA*4.5*360
  1. D BMES^XPDUTL(" >> Starting the Post-Initialization routine for PRCA*4.5*360 ")
  1. ; Adding AR CATEGORY
  1. D ARCAT
  1. ; rebuild cross-references
  1. D BMES^XPDUTL(" >> End of the Post-Initialization routine for PRCA*4.5*360")
  1. Q
  1. ;
  1. ARCAT ;AR CATEGORY ENTRY (430.2)
  1. N LOOP,FDA,FDAIEN,DATA,CHKIEN,NUM,NEWREC,SEMI2
  1. N DA,DIE,DLAYGO,DR,FUND,X,Y
  1. ;
  1. D MES^XPDUTL(" -> Adding new AR CATEGORY entries to file 430.2 ...")
  1. ; Add new AR categories
  1. S SEMI2=2 ; Two semicolons";;" counted for each field
  1. F LOOP=2:1 S DATA=$T(ARDATA+LOOP) Q:$P(DATA,";",3)="END" D
  1. .S NEWREC=1 ; New record indicator
  1. .;Extract the new AR Category to be added.
  1. .;Check to insure that the AR Category doesn't exist already
  1. .S CHKIEN="" ; Initialized the check variable
  1. .S CHKIEN=$O(^PRCA(430.2,"B",$P(DATA,";",3),"")) ; Category Name (UNEDITABLE)
  1. .I +CHKIEN S NEWREC=0 D MES^XPDUTL($P(DATA,";",3)_" already exist and updating...")
  1. . K DD,DO,Y
  1. . S DLAYGO=430.2,DIC="^PRCA(430.2,",DIC(0)="L",X=$P(DATA,";",3)
  1. . ;
  1. . ; If no entry found, create a new entry
  1. . I '+CHKIEN D FILE^DICN S CHKIEN=+Y K DIC,DINUM,DLAYGO
  1. . ;
  1. .S DR=""
  1. .; Field# | Name of field
  1. .S:NEWREC=1 DR="1///"_$P(DATA,";",2+SEMI2) ; 1 | Abbreviation (UNEDITABLE)
  1. .S DR=DR_";2///"_$P(DATA,";",3+SEMI2) ; 2 | AMIS Seg # (UNEDITABLE)
  1. .S DR=DR_";3///"_$P(DATA,";",4+SEMI2) ; 3 | GL Number
  1. .S DR=DR_";5///"_$P(DATA,";",5+SEMI2) ; 5 | Type (P,O,T,V,C,N)
  1. .S:NEWREC=1 DR=DR_";6////"_$P(DATA,";",6+SEMI2) ; 6 | Category number (UNEDITABLE)
  1. .S DR=DR_";7///"_$P(DATA,";",7+SEMI2) ; 7 | Receivable Code
  1. .S DR=DR_";9///"_$P(DATA,";",11+SEMI2) ; 9 | Interest
  1. .S DR=DR_";10///"_$P(DATA,";",9+SEMI2) ;10 | Admin
  1. .S DR=DR_";11///"_$P(DATA,";",10+SEMI2) ;11 | Penalty
  1. .S:NEWREC=1 DR=DR_";12///"_$P(DATA,";",11+SEMI2) ;12 | Accrued (UNEDITABLE)
  1. .S DR=DR_";13///"_$P(DATA,";",12+SEMI2) ;13 | Refund
  1. .S DR=DR_";14///"_$P(DATA,";",13+SEMI2) ;14 | Paragraph Codes
  1. .; REFERRALS
  1. .S DR=DR_";1.01///1;" ;1.01 | Refer to DMC?
  1. .S DR=DR_"1.02///2;" ;1.02 | Refer to TOP?
  1. .S DR=DR_"1.03///3" ;1.03 | Refer to CS?
  1. .;
  1. .I $E(DR,1)=";" S DR=$P(DR,";",2,$L(DR)) ; Remove ";" to update existing record with data specified in fields
  1. .;
  1. .S DIE="^PRCA(430.2,",DA=CHKIEN
  1. .D ^DIE
  1. S DA=CHKIEN,DIK="^IBE(430.2," D IX^DIK ; Re-Index
  1. D MES^XPDUTL(" New AR CATEGORY added.")
  1. Q
  1. ; ACTUAL FIELD SETTINGS NEXT LINE
  1. ;;CC URGENT CARE;U1;240;1221;P;87;2;1;1;0;1;2;30,40,55,80,85,50,60,65,70
  1. ;
  1. ; field 1 2 3 4 5 6 7 8 9 10111213
  1. 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
  1. ;;CC URGENT CARE;U1;240;1221;P;87;2;1;1;0;1;2;30,40,55,80,85,50,60,65,70
  1. ;;END