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