Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCUFC0

PRCUFC0.m

Go to the documentation of this file.
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