Routine: ACRFSPL6

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)

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

ACRFSPL6.m