| 1 | PRCUFC0 ;WISC/SJG-ENTRY ROUTINE FOR IFCAP/FMS CONVERSION ;12/20/93 11:25
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | QUIT
|
|---|
| 5 | ; No top level entry
|
|---|
| 6 | EN(LOOP,SCP,POSTAT,ND0,ND1) ; Supply Fund and General Post Fund Conversion
|
|---|
| 7 | ; Routine called by ^PRCHPRCV
|
|---|
| 8 | ; LOOP = Internal Record Number from File 442
|
|---|
| 9 | ; SCP = Special Fund Control Point
|
|---|
| 10 | ; POSTAT = Purchase Order Status
|
|---|
| 11 | ; ND0 = Node 0 of 442 entry
|
|---|
| 12 | ; ND1 = Node 1 of 442 entry
|
|---|
| 13 | ; SCP = 1 for GPF, SCP = 2 for Supply Fund
|
|---|
| 14 | Q:SCP=""!(SCP>2)
|
|---|
| 15 | S ND(0)=ND0,ND(1)=ND1
|
|---|
| 16 | S PRCFA("CONV")=1
|
|---|
| 17 | K PRCTMP S (FATAL,FMSFLG)=0
|
|---|
| 18 | EN1 I SCP=1 D
|
|---|
| 19 | .S PRCFA("CONVG")=1
|
|---|
| 20 | .I ("^10^20^35^36^40^45^42^43^71^81^82^"[("^"_POSTAT_"^")) D Q
|
|---|
| 21 | ..D GENDIQ^PRCFFU7(442,LOOP,".1;1;26","IE","")
|
|---|
| 22 | ..D CHKVAR,BOCG^PRCUFCU,NODE22
|
|---|
| 23 | ..Q
|
|---|
| 24 | .I ("^6^25^26^"[("^"_POSTAT_"^")) D Q
|
|---|
| 25 | ..I $D(^PRC(442,LOOP,11)) D ERR4 Q
|
|---|
| 26 | ..D GENDIQ^PRCFFU7(442,LOOP,".1;1;26;91;92;93;","IE","")
|
|---|
| 27 | ..D CHKVAR,BOCG^PRCUFCU,NODE22
|
|---|
| 28 | ..D AMTS^PRCUFCU Q:FATAL
|
|---|
| 29 | ..D GPFO^PRCUFC1
|
|---|
| 30 | ..Q
|
|---|
| 31 | .I ("^7^15^30^31^"[("^"_POSTAT_"^")) D Q
|
|---|
| 32 | ..I '$D(^PRC(442,LOOP,11)) D ERR4 Q
|
|---|
| 33 | ..D GENDIQ^PRCFFU7(442,LOOP,".1;1;26;91;92;93","IE","")
|
|---|
| 34 | ..D CHKVAR,BOCG^PRCUFCU,NODE22
|
|---|
| 35 | ..D AMTS^PRCUFCU Q:FATAL
|
|---|
| 36 | ..D GPFM^PRCUFC1
|
|---|
| 37 | ..Q
|
|---|
| 38 | .Q
|
|---|
| 39 | EN2 I SCP=2 D
|
|---|
| 40 | .S PRCFA("CONVS")=1
|
|---|
| 41 | .I ("^10^20^35^36^40^45^42^43^71^81^82^"[("^"_POSTAT_"^")) D Q
|
|---|
| 42 | ..D GENDIQ^PRCFFU7(442,LOOP,".1;1;26","IE","")
|
|---|
| 43 | ..D CHKVAR,BOCS^PRCUFCU,NODE22
|
|---|
| 44 | ..Q
|
|---|
| 45 | .I ("^6^25^26^"[("^"_POSTAT_"^")) D Q
|
|---|
| 46 | ..I $D(^PRC(442,LOOP,11)) D ERR4 Q
|
|---|
| 47 | ..D GENDIQ^PRCFFU7(442,LOOP,".1;1;26;91;92;93","IE","")
|
|---|
| 48 | ..D CHKVAR,BOCS^PRCUFCU,NODE22
|
|---|
| 49 | ..D AMTS^PRCUFCU Q:FATAL
|
|---|
| 50 | ..D SUPPO^PRCUFC2
|
|---|
| 51 | ..Q
|
|---|
| 52 | .I ("^7^15^30^31^"[("^"_POSTAT_"^")) D Q
|
|---|
| 53 | ..I '$D(^PRC(442,LOOP,11)) D ERR4 Q
|
|---|
| 54 | ..D GENDIQ^PRCFFU7(442,LOOP,".1;1;26;91;92;93","IE","")
|
|---|
| 55 | ..D CHKVAR,BOCS^PRCUFCU,NODE22
|
|---|
| 56 | ..D AMTS^PRCUFCU Q:FATAL
|
|---|
| 57 | ..D SUPPM^PRCUFC2
|
|---|
| 58 | ..Q
|
|---|
| 59 | EXIT KILL GECSFMS,ND,PRCFA,PRCFCHG,PRCFMO,PRCTMP
|
|---|
| 60 | KILL DIC,D0,DLAYGO
|
|---|
| 61 | KILL AMTTOT,BEGDATE,BBFY,BOC,ESHFLG,FATAL,FMSFLG,FMSLIN,FMSMOD,FMSVENID,FOB,IDFLAG
|
|---|
| 62 | KILL LOOP1,LOOP3,MOD,NODET,NUMB,PARAM1,PO,PODATE,POSTAT,PRCCC,PRCCP,PRCCCC,PRCCSCC
|
|---|
| 63 | KILL PRCHPO,PRCOPODA,PRCREQST,PRCSTA,PRCSTR,SCP,STR2,TOTAMT,X,Y
|
|---|
| 64 | QUIT
|
|---|
| 65 | NODE22 ; Check/build Node 22 for commodity line roll
|
|---|
| 66 | S (DA,PRCHPO)=LOOP D ^PRCHSF
|
|---|
| 67 | Q
|
|---|
| 68 | CHKVAR ; Check/set PRC() variables
|
|---|
| 69 | N DATE,FCP
|
|---|
| 70 | S DATE=$G(PRCTMP(442,LOOP,.1,"I")) I DATE]"" D
|
|---|
| 71 | .S DATE=$$DATE^PRC0C(DATE,"I")
|
|---|
| 72 | .S PRC("FY")=$E($P(DATE,U),3,4)
|
|---|
| 73 | .S PRC("QTR")=$P(DATE,U,2)
|
|---|
| 74 | S PRC("SITE")=+$G(ND(0))
|
|---|
| 75 | S FCP=+$G(PRCTMP(442,LOOP,1,"I"))
|
|---|
| 76 | I FCP]"" S PRC("CP")=+FCP
|
|---|
| 77 | I '$D(PRC("PER")) D DUZ^PRCFSITE
|
|---|
| 78 | Q
|
|---|
| 79 | ;
|
|---|
| 80 | ERR4 S ERROR="ERR4" D EN^PRCUFC0E(LOOP,ERROR) Q
|
|---|
| 81 | ERR5 S ERROR="ERR5" D EN^PRCUFC0E(LOOP,ERROR) Q
|
|---|
