50 lines
1.7 KiB
Mathematica
50 lines
1.7 KiB
Mathematica
PRCFFU3A ;WISC/SJG-FMS LIN,RCA,RCB,RCC SEGMENTS (AR TRANSACTION);4/27/94 1:39 PM
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
;BUILD 'LIN' SEGMENT
|
|
LIN S TMPLINE=TMPLINE+1
|
|
S ^TMP($J,"PRCMO",INT,TMPLINE)="LIN^~"
|
|
Q
|
|
;
|
|
;BUILD 'RCA' SEGMENT
|
|
RCA N SEG,BOC,AMT,NUM,FOB
|
|
S FOB=""
|
|
I $D(PRCFA("FOB")),TYCODE'="M"!(PRCFA("FOB")]"") S FOB=$G(PRCTMP(442,+PO,6.4,"I")) I FOB="" S FOB="D"
|
|
I PRCFA("MP")=21,TRCODE'="MO",TYCODE="M" D G MOASEG
|
|
.S BOC=+$P(TRNODE(3),"^",6)
|
|
.S AMT=$J($P(TRNODE(4),"^",8),0,2)
|
|
.S NUM=$E("00"_NUMB,$L(NUMB),99)
|
|
; POs, MOs, orig 1358
|
|
S AMT=$P(FMSNOD,U,2) I TYCODE="E" Q:AMT'>0
|
|
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)
|
|
I TYCODE="E" I NUM=991 I (FOB="D")&(+AMT=0) Q
|
|
I TYCODE="M",'$D(PRCFCHG("BOC",BOC,NUMB)) Q
|
|
I TYCODE="M",$D(PRCFCHG("BOC",BOC,NUMB)) D
|
|
.S AMT=$J($P(PRCFCHG("BOC",BOC,NUMB),U,2),0,2)
|
|
.S IDFLAG=$P(PRCFCHG("BOC",BOC,NUMB),U,4)
|
|
;
|
|
MOASEG S TMPLINE=TMPLINE+1,SEG=""
|
|
I TYCODE="E" S $P(SEG,U,21)="01"
|
|
S $P(SEG,U,19)=NUM,$P(SEG,U,20)=NUM,$P(SEG,U,22)=PRCBUD,$P(SEG,U,30)=BOC
|
|
I $D(PRCFMO("JOB")),PRCFMO("JOB")="Y" S $P(SEG,U,32)=$P(PRCSTR,U,10)
|
|
I $D(PRCFMO("RC")),PRCFMO("RC")="Y" S $P(SEG,U,33)=""
|
|
S $P(SEG,U,34)=$FN(AMT,"-",2),$P(SEG,U,35)=IDFLAG
|
|
I IDFLAG="D" S $P(SEG,U,36)="F"
|
|
S ^TMP($J,"PRCMO",INT,TMPLINE)="LIN^~RCA^"_SEG_"^~"
|
|
QUIT
|
|
;
|
|
;BUILD 'RCB' SEGMENT
|
|
RCB N SEG
|
|
S TMPLINE=TMPLINE+1,SEG=""
|
|
S ^TMP($J,"PRCMO",INT,TMPLINE)="RCB^~"
|
|
I SEG S ^TMP($J,"PRCMO",INT,TMPLINE)="RCB^"_SEG_"^~"
|
|
Q
|
|
;
|
|
;BUILD 'RCC' SEGMENT
|
|
RCC N SEG
|
|
S TMPLINE=TMPLINE+1,SEG=""
|
|
S ^TMP($J,"PRCMO",INT,TMPLINE)="RCC^~"
|
|
I SEG S ^TMP($J,"PRCMO",INT,TMPLINE)="RCC^"_SEG_"^~"
|
|
Q
|