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 Apr 09, 2024@20:48:35 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
