source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFU3A.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.7 KB
RevLine 
[613]1PRCFFU3A ;WISC/SJG-FMS LIN,RCA,RCB,RCC SEGMENTS (AR TRANSACTION);4/27/94 1:39 PM
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 ;BUILD 'LIN' SEGMENT
6LIN S TMPLINE=TMPLINE+1
7 S ^TMP($J,"PRCMO",INT,TMPLINE)="LIN^~"
8 Q
9 ;
10 ;BUILD 'RCA' SEGMENT
11RCA 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 ;
27MOASEG 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
38RCB 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
45RCC 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
Note: See TracBrowser for help on using the repository browser.