PRCUFC0 ;WISC/SJG-ENTRY ROUTINE FOR IFCAP/FMS CONVERSION ;12/20/93 11:25 V ;;5.1;IFCAP;;Oct 20, 2000 ;Per VHA Directive 10-93-142, this routine should not be modified. QUIT ; No top level entry EN(LOOP,SCP,POSTAT,ND0,ND1) ; Supply Fund and General Post Fund Conversion ; Routine called by ^PRCHPRCV ; LOOP = Internal Record Number from File 442 ; SCP = Special Fund Control Point ; POSTAT = Purchase Order Status ; ND0 = Node 0 of 442 entry ; ND1 = Node 1 of 442 entry ; SCP = 1 for GPF, SCP = 2 for Supply Fund Q:SCP=""!(SCP>2) S ND(0)=ND0,ND(1)=ND1 S PRCFA("CONV")=1 K PRCTMP S (FATAL,FMSFLG)=0 EN1 I SCP=1 D .S PRCFA("CONVG")=1 .I ("^10^20^35^36^40^45^42^43^71^81^82^"[("^"_POSTAT_"^")) D Q ..D GENDIQ^PRCFFU7(442,LOOP,".1;1;26","IE","") ..D CHKVAR,BOCG^PRCUFCU,NODE22 ..Q .I ("^6^25^26^"[("^"_POSTAT_"^")) D Q ..I $D(^PRC(442,LOOP,11)) D ERR4 Q ..D GENDIQ^PRCFFU7(442,LOOP,".1;1;26;91;92;93;","IE","") ..D CHKVAR,BOCG^PRCUFCU,NODE22 ..D AMTS^PRCUFCU Q:FATAL ..D GPFO^PRCUFC1 ..Q .I ("^7^15^30^31^"[("^"_POSTAT_"^")) D Q ..I '$D(^PRC(442,LOOP,11)) D ERR4 Q ..D GENDIQ^PRCFFU7(442,LOOP,".1;1;26;91;92;93","IE","") ..D CHKVAR,BOCG^PRCUFCU,NODE22 ..D AMTS^PRCUFCU Q:FATAL ..D GPFM^PRCUFC1 ..Q .Q EN2 I SCP=2 D .S PRCFA("CONVS")=1 .I ("^10^20^35^36^40^45^42^43^71^81^82^"[("^"_POSTAT_"^")) D Q ..D GENDIQ^PRCFFU7(442,LOOP,".1;1;26","IE","") ..D CHKVAR,BOCS^PRCUFCU,NODE22 ..Q .I ("^6^25^26^"[("^"_POSTAT_"^")) D Q ..I $D(^PRC(442,LOOP,11)) D ERR4 Q ..D GENDIQ^PRCFFU7(442,LOOP,".1;1;26;91;92;93","IE","") ..D CHKVAR,BOCS^PRCUFCU,NODE22 ..D AMTS^PRCUFCU Q:FATAL ..D SUPPO^PRCUFC2 ..Q .I ("^7^15^30^31^"[("^"_POSTAT_"^")) D Q ..I '$D(^PRC(442,LOOP,11)) D ERR4 Q ..D GENDIQ^PRCFFU7(442,LOOP,".1;1;26;91;92;93","IE","") ..D CHKVAR,BOCS^PRCUFCU,NODE22 ..D AMTS^PRCUFCU Q:FATAL ..D SUPPM^PRCUFC2 ..Q EXIT KILL GECSFMS,ND,PRCFA,PRCFCHG,PRCFMO,PRCTMP KILL DIC,D0,DLAYGO KILL AMTTOT,BEGDATE,BBFY,BOC,ESHFLG,FATAL,FMSFLG,FMSLIN,FMSMOD,FMSVENID,FOB,IDFLAG KILL LOOP1,LOOP3,MOD,NODET,NUMB,PARAM1,PO,PODATE,POSTAT,PRCCC,PRCCP,PRCCCC,PRCCSCC KILL PRCHPO,PRCOPODA,PRCREQST,PRCSTA,PRCSTR,SCP,STR2,TOTAMT,X,Y QUIT NODE22 ; Check/build Node 22 for commodity line roll S (DA,PRCHPO)=LOOP D ^PRCHSF Q CHKVAR ; Check/set PRC() variables N DATE,FCP S DATE=$G(PRCTMP(442,LOOP,.1,"I")) I DATE]"" D .S DATE=$$DATE^PRC0C(DATE,"I") .S PRC("FY")=$E($P(DATE,U),3,4) .S PRC("QTR")=$P(DATE,U,2) S PRC("SITE")=+$G(ND(0)) S FCP=+$G(PRCTMP(442,LOOP,1,"I")) I FCP]"" S PRC("CP")=+FCP I '$D(PRC("PER")) D DUZ^PRCFSITE Q ; ERR4 S ERROR="ERR4" D EN^PRCUFC0E(LOOP,ERROR) Q ERR5 S ERROR="ERR5" D EN^PRCUFC0E(LOOP,ERROR) Q