source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCUFC0.m@ 623

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1PRCUFC0 ;WISC/SJG-ENTRY ROUTINE FOR IFCAP/FMS CONVERSION ;12/20/93 11:25
2V ;;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
6EN(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
18EN1 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
39EN2 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
59EXIT 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
65NODE22 ; Check/build Node 22 for commodity line roll
66 S (DA,PRCHPO)=LOOP D ^PRCHSF
67 Q
68CHKVAR ; 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 ;
80ERR4 S ERROR="ERR4" D EN^PRCUFC0E(LOOP,ERROR) Q
81ERR5 S ERROR="ERR5" D EN^PRCUFC0E(LOOP,ERROR) Q
Note: See TracBrowser for help on using the repository browser.