ACRFSPL6 ;IHS/OIRM/DSD/AEF - 650 Char DHR Record Layout [ 01/03/2003 9:54 AM ]
;;2.1;ADMIN RESOURCE MGT SYSTEM;**5**;NOV 05, 2001
;
DATA(X,Y) ;EP
;----- CREATE DHR RECORD DATA STRING
;
; FORMATS 650 CHAR DHR DATA STRING FROM DHR DATA RECORDS FILE
; CALLED BY ACRFSPL2
;
; X = DATA TO BE FORMATTED
; Y = COLOR^DATE^ID^SEQ^USERID^RECCOUNT
;
;
N I,Z
S $E(Z,1,8)=$$PAD^ACRFUTL($P(Y,U,5),"R",8,"") ;1 User ID
S I=$P(X,U,4)_$P(X,U,5)_$P(X,U,6) ;2 Action Code
S:I="06119" I="06115" ;ACR*2.1*5.01
S $E(Z,9)=$S(I="":" ","05013^06115^19013^19817^19917"[I:"N","05014^05015^05024^05025^05017^19017^18114^19114^18124^18214^18214^19214^19927^23717^24219"[I:"A",1:" ") ;ACR*2.1*5.01
S $E(Z,10,13)=$$PAD^ACRFUTL($P(X,U,4),"R",4,"") ;3 Transaction Code
S I=$P(X,U,3) ;4 Accounting Date
I I]"" S I=$E(I,4,5)_$E(I,6,7)_$E(I,2,3)
S $E(Z,14,19)=$$PAD^ACRFUTL(I,"R",6,"")
S $E(Z,20,21)=$$PAD^ACRFUTL($P(X,U,29),"R",2,"") ;5 Fiscal Year
S $E(Z,22,31)=$$PAD^ACRFUTL($P(X,U,7),"R",10,"") ;6 Form Number
S $E(Z,32,51)=$$PAD^ACRFUTL($P(X,U,8),"R",20,"") ;7 Document Number
S $E(Z,52,59)=$$PAD^ACRFUTL($P(X,U,13),"R",7,"")_" " ;8 CAN
F I=60:1:89 S $E(Z,I)=" " ;9 CAN Desc.
S $E(Z,90,93)=$$PAD^ACRFUTL($P(X,U,14),"R",4,"") ;10 OCC
F I=94:1:113 S $E(Z,I)=" " ;11 OC Short Desc.
S $E(Z,114,129)=$$PAD^ACRFUTL($P(X,U,15),"L",16,0) ;12 Amount
S $E(Z,130)=$S($P(X,U,5)=1:"+",$P(X,U,5)=2:"-",1:" ") ;13 Sign on Amt.
S $E(Z,131)=" " ;14 PMS Sent Flag
S $E(Z,132,151)=$$PAD^ACRFUTL($P(X,U,10),"R",20,"") ;15 Commit No.
S $E(Z,152,171)=$$PAD^ACRFUTL($P(X,U,19),"R",20,"") ;16 Collection No.
S $E(Z,172,191)=$$PAD^ACRFUTL($P(X,U,33),"R",20,"") ;17 Invoice No
S $E(Z,192,211)=$$PAD^ACRFUTL($P(X,U,19),"R",20,"") ;18 Schedule No
S $E(Z,212,223)=$$PAD^ACRFUTL($P(X,U,17),"R",12,"") ;19 Entity Ident No
F I=224:1:258 S $E(Z,I)=" " ;20 Vendor Name
F I=259:1:288 S $E(Z,I)=" " ;21 Vendor Address
F I=289:1:343 S $E(Z,I)=" " ;22 Comment
S $E(Z,344,349)=$$PAD^ACRFUTL($P(X,U,27),"R",6,"") ;23 Begin Date
S $E(Z,350,355)=$$PAD^ACRFUTL($P(X,U,28),"R",6,"") ;24 End Date
F I=356:1:364 S $E(Z,I)=" " ;25 Labor Hours
S $E(Z,365)=" " ;26 Sign on Hours
F I=366:1:385 S $E(Z,I)=" " ;27 Agreement No
F I=386:1:405 S $E(Z,I)=" " ;28 Project Number
S $E(Z,406,407)=" " ;29 Phase
S $E(Z,408,411)=$$PAD^ACRFUTL($P(X,U,24),"R",4,"") ;30 GL Debit
S $E(Z,412,415)=$$PAD^ACRFUTL($P(X,U,25),"R",4,"") ;31 GL Credit
S $E(Z,416)=" " ;32 PMS Code
S $E(Z,417)=" " ;33 SysGen Code
S $E(Z,418)=$$PAD^ACRFUTL($P(X,U,11),"R",1,"") ;34 Geographic Code
F I=419:1:430 S $E(Z,I)=" " ;35 Secondary EIN
F I=431:1:465 S $E(Z,I)=" " ;36 2nd Vend Name
F I=466:1:495 S $E(Z,I)=" " ;37 2nd Addr Line
S $E(Z,496)=" " ;38 Act/Law Code
S $E(Z,497)=" " ;39 Curr/Perm Code
S $E(Z,498)=$$PAD^ACRFUTL($P(X,U,16),"R",1,"") ;40 Gov/Non-Govt
S $E(Z,499)=" " ;41 Funded/UnFunded
S $E(Z,500)=" " ;42 Reserved Code
S $E(Z,501,502)=" " ;43 Filler
S $E(Z,503)=" " ;44 Partial/Final
S $E(Z,504)=" " ;45 Est Accrual Flg
S $E(Z,505,508)="AR " ;46 Transaction Src
F I=509:1:518 S $E(Z,I)=" " ;47 Agency Location
S $E(Z,519,520)=" " ;48 PMS/Core Only
S $E(Z,521,524)=" " ;49 Filler
F I=525:1:547 S $E(Z,I)=" " ;50 Standing Entry
S $E(Z,548,553)=" " ;51 Filler
F I=554:1:568 S $E(Z,I)=" " ;52 AcctRecTypeDesc
S $E(Z,569,572)=" " ;53 Next Funct Code
F I=573:1:650 S $E(Z,I)=" " ;54 Message Line
;
S ^TMP("ACRDHR",$J,$P(Y,U),$P(Y,U,2),$P(Y,U,3),$P(Y,U,4),1)=$E(Z,1,130)
S ^TMP("ACRDHR",$J,$P(Y,U),$P(Y,U,2),$P(Y,U,3),$P(Y,U,4),2)=$E(Z,131,260)
S ^TMP("ACRDHR",$J,$P(Y,U),$P(Y,U,2),$P(Y,U,3),$P(Y,U,4),3)=$E(Z,261,390)
S ^TMP("ACRDHR",$J,$P(Y,U),$P(Y,U,2),$P(Y,U,3),$P(Y,U,4),4)=$E(Z,391,520)
S ^TMP("ACRDHR",$J,$P(Y,U),$P(Y,U,2),$P(Y,U,3),$P(Y,U,4),5)=$E(Z,521,650)
S ^TMP("ACRDHR-EXP",$J,$P(Y,U,6),1)=$E(Z,1,130)
S ^TMP("ACRDHR-EXP",$J,$P(Y,U,6),2)=$E(Z,131,260)
S ^TMP("ACRDHR-EXP",$J,$P(Y,U,6),3)=$E(Z,261,390)
S ^TMP("ACRDHR-EXP",$J,$P(Y,U,6),4)=$E(Z,391,520)
S ^TMP("ACRDHR-EXP",$J,$P(Y,U,6),5)=$E(Z,521,650)
Q
ACRFSPL6 ;IHS/OIRM/DSD/AEF - 650 Char DHR Record Layout [ 01/03/2003 9:54 AM ]
+1 ;;2.1;ADMIN RESOURCE MGT SYSTEM;**5**;NOV 05, 2001
+2 ;
DATA(X,Y) ;EP
+1 ;----- CREATE DHR RECORD DATA STRING
+2 ;
+3 ; FORMATS 650 CHAR DHR DATA STRING FROM DHR DATA RECORDS FILE
+4 ; CALLED BY ACRFSPL2
+5 ;
+6 ; X = DATA TO BE FORMATTED
+7 ; Y = COLOR^DATE^ID^SEQ^USERID^RECCOUNT
+8 ;
+9 ;
+10 NEW I,Z
+11 ;1 User ID
SET $EXTRACT(Z,1,8)=$$PAD^ACRFUTL($PIECE(Y,U,5),"R",8,"")
+12 ;2 Action Code
SET I=$PIECE(X,U,4)_$PIECE(X,U,5)_$PIECE(X,U,6)
+13 ;ACR*2.1*5.01
IF I="06119"
SET I="06115"
+14 ;ACR*2.1*5.01
SET $EXTRACT(Z,9)=$SELECT(I="":" ","05013^06115^19013^19817^19917"[I:"N","05014^05015^05024^05025^05017^19017^18114^19114^18124^18214^18214^19214^19927^23717^24219"[I:"A",1:" ")
+15 ;3 Transaction Code
SET $EXTRACT(Z,10,13)=$$PAD^ACRFUTL($PIECE(X,U,4),"R",4,"")
+16 ;4 Accounting Date
SET I=$PIECE(X,U,3)
+17 IF I]""
SET I=$EXTRACT(I,4,5)_$EXTRACT(I,6,7)_$EXTRACT(I,2,3)
+18 SET $EXTRACT(Z,14,19)=$$PAD^ACRFUTL(I,"R",6,"")
+19 ;5 Fiscal Year
SET $EXTRACT(Z,20,21)=$$PAD^ACRFUTL($PIECE(X,U,29),"R",2,"")
+20 ;6 Form Number
SET $EXTRACT(Z,22,31)=$$PAD^ACRFUTL($PIECE(X,U,7),"R",10,"")
+21 ;7 Document Number
SET $EXTRACT(Z,32,51)=$$PAD^ACRFUTL($PIECE(X,U,8),"R",20,"")
+22 ;8 CAN
SET $EXTRACT(Z,52,59)=$$PAD^ACRFUTL($PIECE(X,U,13),"R",7,"")_" "
+23 ;9 CAN Desc.
FOR I=60:1:89
SET $EXTRACT(Z,I)=" "
+24 ;10 OCC
SET $EXTRACT(Z,90,93)=$$PAD^ACRFUTL($PIECE(X,U,14),"R",4,"")
+25 ;11 OC Short Desc.
FOR I=94:1:113
SET $EXTRACT(Z,I)=" "
+26 ;12 Amount
SET $EXTRACT(Z,114,129)=$$PAD^ACRFUTL($PIECE(X,U,15),"L",16,0)
+27 ;13 Sign on Amt.
SET $EXTRACT(Z,130)=$SELECT($PIECE(X,U,5)=1:"+",$PIECE(X,U,5)=2:"-",1:" ")
+28 ;14 PMS Sent Flag
SET $EXTRACT(Z,131)=" "
+29 ;15 Commit No.
SET $EXTRACT(Z,132,151)=$$PAD^ACRFUTL($PIECE(X,U,10),"R",20,"")
+30 ;16 Collection No.
SET $EXTRACT(Z,152,171)=$$PAD^ACRFUTL($PIECE(X,U,19),"R",20,"")
+31 ;17 Invoice No
SET $EXTRACT(Z,172,191)=$$PAD^ACRFUTL($PIECE(X,U,33),"R",20,"")
+32 ;18 Schedule No
SET $EXTRACT(Z,192,211)=$$PAD^ACRFUTL($PIECE(X,U,19),"R",20,"")
+33 ;19 Entity Ident No
SET $EXTRACT(Z,212,223)=$$PAD^ACRFUTL($PIECE(X,U,17),"R",12,"")
+34 ;20 Vendor Name
FOR I=224:1:258
SET $EXTRACT(Z,I)=" "
+35 ;21 Vendor Address
FOR I=259:1:288
SET $EXTRACT(Z,I)=" "
+36 ;22 Comment
FOR I=289:1:343
SET $EXTRACT(Z,I)=" "
+37 ;23 Begin Date
SET $EXTRACT(Z,344,349)=$$PAD^ACRFUTL($PIECE(X,U,27),"R",6,"")
+38 ;24 End Date
SET $EXTRACT(Z,350,355)=$$PAD^ACRFUTL($PIECE(X,U,28),"R",6,"")
+39 ;25 Labor Hours
FOR I=356:1:364
SET $EXTRACT(Z,I)=" "
+40 ;26 Sign on Hours
SET $EXTRACT(Z,365)=" "
+41 ;27 Agreement No
FOR I=366:1:385
SET $EXTRACT(Z,I)=" "
+42 ;28 Project Number
FOR I=386:1:405
SET $EXTRACT(Z,I)=" "
+43 ;29 Phase
SET $EXTRACT(Z,406,407)=" "
+44 ;30 GL Debit
SET $EXTRACT(Z,408,411)=$$PAD^ACRFUTL($PIECE(X,U,24),"R",4,"")
+45 ;31 GL Credit
SET $EXTRACT(Z,412,415)=$$PAD^ACRFUTL($PIECE(X,U,25),"R",4,"")
+46 ;32 PMS Code
SET $EXTRACT(Z,416)=" "
+47 ;33 SysGen Code
SET $EXTRACT(Z,417)=" "
+48 ;34 Geographic Code
SET $EXTRACT(Z,418)=$$PAD^ACRFUTL($PIECE(X,U,11),"R",1,"")
+49 ;35 Secondary EIN
FOR I=419:1:430
SET $EXTRACT(Z,I)=" "
+50 ;36 2nd Vend Name
FOR I=431:1:465
SET $EXTRACT(Z,I)=" "
+51 ;37 2nd Addr Line
FOR I=466:1:495
SET $EXTRACT(Z,I)=" "
+52 ;38 Act/Law Code
SET $EXTRACT(Z,496)=" "
+53 ;39 Curr/Perm Code
SET $EXTRACT(Z,497)=" "
+54 ;40 Gov/Non-Govt
SET $EXTRACT(Z,498)=$$PAD^ACRFUTL($PIECE(X,U,16),"R",1,"")
+55 ;41 Funded/UnFunded
SET $EXTRACT(Z,499)=" "
+56 ;42 Reserved Code
SET $EXTRACT(Z,500)=" "
+57 ;43 Filler
SET $EXTRACT(Z,501,502)=" "
+58 ;44 Partial/Final
SET $EXTRACT(Z,503)=" "
+59 ;45 Est Accrual Flg
SET $EXTRACT(Z,504)=" "
+60 ;46 Transaction Src
SET $EXTRACT(Z,505,508)="AR "
+61 ;47 Agency Location
FOR I=509:1:518
SET $EXTRACT(Z,I)=" "
+62 ;48 PMS/Core Only
SET $EXTRACT(Z,519,520)=" "
+63 ;49 Filler
SET $EXTRACT(Z,521,524)=" "
+64 ;50 Standing Entry
FOR I=525:1:547
SET $EXTRACT(Z,I)=" "
+65 ;51 Filler
SET $EXTRACT(Z,548,553)=" "
+66 ;52 AcctRecTypeDesc
FOR I=554:1:568
SET $EXTRACT(Z,I)=" "
+67 ;53 Next Funct Code
SET $EXTRACT(Z,569,572)=" "
+68 ;54 Message Line
FOR I=573:1:650
SET $EXTRACT(Z,I)=" "
+69 ;
+70 SET ^TMP("ACRDHR",$JOB,$PIECE(Y,U),$PIECE(Y,U,2),$PIECE(Y,U,3),$PIECE(Y,U,4),1)=$EXTRACT(Z,1,130)
+71 SET ^TMP("ACRDHR",$JOB,$PIECE(Y,U),$PIECE(Y,U,2),$PIECE(Y,U,3),$PIECE(Y,U,4),2)=$EXTRACT(Z,131,260)
+72 SET ^TMP("ACRDHR",$JOB,$PIECE(Y,U),$PIECE(Y,U,2),$PIECE(Y,U,3),$PIECE(Y,U,4),3)=$EXTRACT(Z,261,390)
+73 SET ^TMP("ACRDHR",$JOB,$PIECE(Y,U),$PIECE(Y,U,2),$PIECE(Y,U,3),$PIECE(Y,U,4),4)=$EXTRACT(Z,391,520)
+74 SET ^TMP("ACRDHR",$JOB,$PIECE(Y,U),$PIECE(Y,U,2),$PIECE(Y,U,3),$PIECE(Y,U,4),5)=$EXTRACT(Z,521,650)
+75 SET ^TMP("ACRDHR-EXP",$JOB,$PIECE(Y,U,6),1)=$EXTRACT(Z,1,130)
+76 SET ^TMP("ACRDHR-EXP",$JOB,$PIECE(Y,U,6),2)=$EXTRACT(Z,131,260)
+77 SET ^TMP("ACRDHR-EXP",$JOB,$PIECE(Y,U,6),3)=$EXTRACT(Z,261,390)
+78 SET ^TMP("ACRDHR-EXP",$JOB,$PIECE(Y,U,6),4)=$EXTRACT(Z,391,520)
+79 SET ^TMP("ACRDHR-EXP",$JOB,$PIECE(Y,U,6),5)=$EXTRACT(Z,521,650)
+80 QUIT
