| 1 | PRCUFCC ;WISC/SJG-FMS LIN,MOA SEGMENTS FOR CONVERSION ONLY ;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 | ; Routine modiifcation of PRCFFU3 for conversion processing
|
|---|
| 6 | LIN ;BUILD 'LIN' SEGMENT
|
|---|
| 7 | S TMPLINE=TMPLINE+1
|
|---|
| 8 | S ^TMP($J,"PRCMO",INT,TMPLINE)="LIN^~"
|
|---|
| 9 | Q
|
|---|
| 10 | MOA ;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)
|
|---|
| 24 | MOASEG 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
|
|---|
| 31 | MOB ;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
|
|---|
| 37 | MOZ ;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
|
|---|
| 43 | BUD(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)
|
|---|
| 50 | SITE 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)=""
|
|---|
| 53 | CC 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=""
|
|---|
| 56 | SUBCC 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=""
|
|---|
| 60 | STR S $P(STR2,U,6)=PRCCCC,$P(STR2,U,7)=PRCCSCC
|
|---|
| 61 | S $P(STR2,U,8)=$P(PRCSTR,U,3)
|
|---|
| 62 | Q STR2
|
|---|
