| 1 | PRCFFU3A ;WISC/SJG-FMS LIN,RCA,RCB,RCC SEGMENTS (AR TRANSACTION);4/27/94 1:39 PM
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ;BUILD 'LIN' SEGMENT
|
|---|
| 6 | LIN S TMPLINE=TMPLINE+1
|
|---|
| 7 | S ^TMP($J,"PRCMO",INT,TMPLINE)="LIN^~"
|
|---|
| 8 | Q
|
|---|
| 9 | ;
|
|---|
| 10 | ;BUILD 'RCA' SEGMENT
|
|---|
| 11 | RCA N SEG,BOC,AMT,NUM,FOB
|
|---|
| 12 | S FOB=""
|
|---|
| 13 | I $D(PRCFA("FOB")),TYCODE'="M"!(PRCFA("FOB")]"") S FOB=$G(PRCTMP(442,+PO,6.4,"I")) I FOB="" S FOB="D"
|
|---|
| 14 | I PRCFA("MP")=21,TRCODE'="MO",TYCODE="M" D G MOASEG
|
|---|
| 15 | .S BOC=+$P(TRNODE(3),"^",6)
|
|---|
| 16 | .S AMT=$J($P(TRNODE(4),"^",8),0,2)
|
|---|
| 17 | .S NUM=$E("00"_NUMB,$L(NUMB),99)
|
|---|
| 18 | ; POs, MOs, orig 1358
|
|---|
| 19 | S AMT=$P(FMSNOD,U,2) I TYCODE="E" Q:AMT'>0
|
|---|
| 20 | S BOC=$P(FMSNOD,U),AMT=$J($P(FMSNOD,U,2),0,2),NUMB=$P(FMSNOD,U,3),NUM=$E("00"_NUMB,$L(NUMB),99)
|
|---|
| 21 | I TYCODE="E" I NUM=991 I (FOB="D")&(+AMT=0) Q
|
|---|
| 22 | I TYCODE="M",'$D(PRCFCHG("BOC",BOC,NUMB)) Q
|
|---|
| 23 | I TYCODE="M",$D(PRCFCHG("BOC",BOC,NUMB)) D
|
|---|
| 24 | .S AMT=$J($P(PRCFCHG("BOC",BOC,NUMB),U,2),0,2)
|
|---|
| 25 | .S IDFLAG=$P(PRCFCHG("BOC",BOC,NUMB),U,4)
|
|---|
| 26 | ;
|
|---|
| 27 | MOASEG S TMPLINE=TMPLINE+1,SEG=""
|
|---|
| 28 | I TYCODE="E" S $P(SEG,U,21)="01"
|
|---|
| 29 | S $P(SEG,U,19)=NUM,$P(SEG,U,20)=NUM,$P(SEG,U,22)=PRCBUD,$P(SEG,U,30)=BOC
|
|---|
| 30 | I $D(PRCFMO("JOB")),PRCFMO("JOB")="Y" S $P(SEG,U,32)=$P(PRCSTR,U,10)
|
|---|
| 31 | I $D(PRCFMO("RC")),PRCFMO("RC")="Y" S $P(SEG,U,33)=""
|
|---|
| 32 | S $P(SEG,U,34)=$FN(AMT,"-",2),$P(SEG,U,35)=IDFLAG
|
|---|
| 33 | I IDFLAG="D" S $P(SEG,U,36)="F"
|
|---|
| 34 | S ^TMP($J,"PRCMO",INT,TMPLINE)="LIN^~RCA^"_SEG_"^~"
|
|---|
| 35 | QUIT
|
|---|
| 36 | ;
|
|---|
| 37 | ;BUILD 'RCB' SEGMENT
|
|---|
| 38 | RCB N SEG
|
|---|
| 39 | S TMPLINE=TMPLINE+1,SEG=""
|
|---|
| 40 | S ^TMP($J,"PRCMO",INT,TMPLINE)="RCB^~"
|
|---|
| 41 | I SEG S ^TMP($J,"PRCMO",INT,TMPLINE)="RCB^"_SEG_"^~"
|
|---|
| 42 | Q
|
|---|
| 43 | ;
|
|---|
| 44 | ;BUILD 'RCC' SEGMENT
|
|---|
| 45 | RCC N SEG
|
|---|
| 46 | S TMPLINE=TMPLINE+1,SEG=""
|
|---|
| 47 | S ^TMP($J,"PRCMO",INT,TMPLINE)="RCC^~"
|
|---|
| 48 | I SEG S ^TMP($J,"PRCMO",INT,TMPLINE)="RCC^"_SEG_"^~"
|
|---|
| 49 | Q
|
|---|
