source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCUFCC.m@ 770

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

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1PRCUFCC ;WISC/SJG-FMS LIN,MOA SEGMENTS FOR CONVERSION ONLY ;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 ; Routine modiifcation of PRCFFU3 for conversion processing
6LIN ;BUILD 'LIN' SEGMENT
7 S TMPLINE=TMPLINE+1
8 S ^TMP($J,"PRCMO",INT,TMPLINE)="LIN^~"
9 Q
10MOA ;BUILD 'MOA' SEGMENT
11 N SEG,BOC,AMT,NUM
12 I PRCFA("MP")=21 I (TRCODE="SO")&(TYCODE="M") S NUM=NUMB D G MOASEG
13 .N DA K PRCTMP S DIC=442,DR="3;7.2",DA=+PO,DIQ="PRCTMP("
14 .D EN^DIQ1 K DIC,DIQ,DR
15 .S BOC=+$G(PRCTMP(442,+PO,3))
16 .S AMT=$J(+$G(PRCTMP(442,+PO,7.2)),0,2)
17 .S NUM=$E("00"_NUM,$L(NUM),99)
18 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)
19 I TYCODE="E" I NUM=991 I (FOB="D")&(+AMT=0) Q
20 I TYCODE="M",'$D(PRCFCHG("BOC",BOC,NUMB)) Q
21 I TYCODE="M",$D(PRCFCHG("BOC",BOC,NUMB)) D
22 .S AMT=$J($P(PRCFCHG("BOC",BOC,NUMB),U,2),0,2)
23 .S IDFLAG=$P(PRCFCHG("BOC",BOC,NUMB),U,4)
24MOASEG S TMPLINE=TMPLINE+1,SEG=""
25 S SEG=NUM,$P(SEG,U,5)=PRCBUD,$P(SEG,U,13)=BOC
26 I $D(PRCFMO("JOB")),PRCFMO("JOB")="Y" S $P(SEG,U,15)=$P(PRCSTR,U,10)
27 I $D(PRCFMO("RC")),PRCFMO("RC")="Y" S $P(SEG,U,16)=""
28 S $P(SEG,U,17)=AMT,$P(SEG,U,18)=IDFLAG
29 S ^TMP($J,"PRCMO",INT,TMPLINE)="LIN^~MOA^"_SEG_"^~"
30 QUIT
31MOB ;BUILD 'MOB' SEGMENT
32 N SEG
33 S TMPLINE=TMPLINE+1,SEG=""
34 S ^TMP($J,"PRCMO",INT,TMPLINE)="MOB^~"
35 I SEG S ^TMP($J,"PRCMO",INT,TMPLINE)="MOB^"_SEG_"^~"
36 Q
37MOZ ;BUILD 'MOZ' SEGMENT
38 N SEG
39 S TMPLINE=TMPLINE+1,SEG=""
40 S ^TMP($J,"PRCMO",INT,TMPLINE)="MOZ^~"
41 I SEG S ^TMP($J,"PRCMO",INT,TMPLINE)="MOZ^"_SEG_"^~"
42 Q
43BUD(STR1) ;BUILD BUDGET STRING
44 N BFY,EFY S STR2=""
45 S BFY=$E($P(PRCSTR,U,6),3,4),EFY=$E($P(PRCSTR,U,7),3,4)
46 S $P(STR2,U)=BFY
47 I BFY=EFY S $P(STR2,U,2)=""
48 I BFY'=EFY S $P(STR2,U,2)=EFY
49 S STR2=STR2_"^"_$P(PRCSTR,U,5)
50SITE I $D(PRCFMO("SITE")),PRCFMO("SITE")="Y" S $P(STR2,U,4)=PRC("SITE")
51 I '$D(PRCFMO("SITE")) S $P(STR2,U,4)=""
52 I $D(PRCFMO("SITE")),PRCFMO("SITE")="N" S $P(STR2,U,4)=""
53CC I $D(PRCFMO("CC")),PRCFMO("CC")="Y" S PRCCCC=$E(PRCCC,1,4)_"00^"
54 I '$D(PRCFMO("CC")) S PRCCCC=""
55 I $D(PRCFMO("CC")),PRCFMO("CC")="N" S PRCCCC=""
56SUBCC I $D(PRCFA("MOD")),$P(PRCFA("MOD"),U,2)=1 S PRCCSCC="" G STR
57 I $D(PRCFMO("SCC")),PRCFMO("SCC")="Y" S PRCCSCC=$E(PRCCC,5,6)
58 I '$D(PRCFMO("SCC")) S PRCCSCC=""
59 I $D(PRCFMO("SCC")),PRCFMO("SCC")="N" S PRCCSCC=""
60STR S $P(STR2,U,6)=PRCCCC,$P(STR2,U,7)=PRCCSCC
61 S $P(STR2,U,8)=$P(PRCSTR,U,3)
62 Q STR2
Note: See TracBrowser for help on using the repository browser.