source: FOIAVistA/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFERT.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 6.4 KB
Line 
1PRCFFERT ;WISC/SJG-OBLIGATION ERROR PROCESSING REBUILD/RETRANSMIT ;7/24/00 23:20
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4TYPE(X) N FMSNO,STATUS
5 S PRC("SITE")=$P(X,U)
6 I ("^AR^MO^SO^"'[("^"_$P(X,U,2)_"^")) D MSG1^PRCFFERM,OUT Q
7 S STATUS=$G(GECSDATA(2100.1,GECSDATA,3,"E"))
8 D MSG^PRCFFER2($E(STATUS,1),.PRCFA) ; display transaction status info
9 D NUM^PRCFFERU ; put external PO# from GECSDATA into PONUM
10 D GET^PRCFFERU(442,PONUM) ; DIC call
11 I Y<0 D MSG2^PRCFFERM Q
12 S PO=Y,PO(0)=Y(0),PO(0,0)=Y(0,0)
13 S POIEN=+Y
14 K MOP S MOP=$P(Y(0),U,2) I MOP="" D MSG3^PRCFFERM Q
15 D GECS ; save selected txn's type & action in PRCFA("GECS")
16 I ("^1^2^3^4^7^8^26^"[("^"_MOP_"^")) I PRCFA("ERROR") D TPO
17 I MOP=21 I PRCFA("ERROR") D T1358
18 D OUT
19 D SCREEN
20 QUIT
21 ;
22TPO ; Purchase Order Error Processing when MOP = Invoice/Rec Rep,CI,Req
23 I $D(PRCFA("ERTYP")),PRCFA("ERTYP")'="POREQ" W !! D MSG5^PRCFFERM H 3 Q
24 S D0=+Y D STATR1^PRCFFERU(2)
25 S X=$P($G(RESP),U) I X D ^PRCHDP1
26 W ! S RETRAN=$$RETRANS^PRCFFERU(.RETRAN)
27 S X=$P($G(RETRAN),U) I 'X D MSG4^PRCFFERM H 3 Q
28TPO1 D
29 .S PRCFA("RETRAN")=1
30 .S PRCFA("PODA")=+PO,PCP=$P(PO(0),U,3)
31 .S $P(PCP,U,2)=$S($D(^PRC(420,PRC("SITE"),1,+PCP,0)):$P(^(0),U,12),1:"")
32 .I '$D(PRC("FY")) D
33 ..N FYQ S FYQ=$$FYQ^PRCFFERU(.FYQ)
34 ..S PRC("FY")=$P(FYQ,U),PRC("QTR")=$P(FYQ,U,2)
35 ..Q
36 .I '$D(PRC("PARAM")) S PRC("PARAM")=$$NODE^PRC0B("^PRC(411,PRC(""SITE""),",0)
37 .N PRCRGS,MODDOC S FLG=0
38 .S MODDOC=$P($G(PRCFA("GECS")),"^",3)
39 .S PRCRGS=$S(MODDOC="":1,MODDOC]"":2)
40 .I MODDOC="" D RETRAN^PRCFFMO Q
41 .I MODDOC]"" D Q
42 ..N RBLD S RBLD=$G(GECSDATA(2100.1,GECSDATA,26,"E"))
43 ..I RBLD]"" S (PRCFA("AMEND#"),PRCFAA)=$P(RBLD,"/",2),PRCFPODA=+PO
44 ..I RBLD="" D
45 ...S (PRCFA("AMEND#"),X)=0
46 ...F S X=$O(^PRC(442,+PO,6,X)) Q:X'>0 S PRCFAA=X
47 ...S PRCFA("AMEND#")=PRCFAA,PRCFPODA=+PO
48 ...Q
49 ..D SETAM,RETRAN^PRCFFMOM
50 ..Q
51 .Q
52 Q
53SETPO ;
54 S FMSSEC=$$SEC1^PRC0C(PRC("SITE"))
55 S DESC="Purchase Order Obligation Rebuild/Transmit"
56 S:MODDOC]"" DESC="Purchase Order Amendment Rebuild/Transmit"
57 D REBUILD^GECSUFM1(GECSDATA,"I",FMSSEC,"Y",DESC)
58 S GECSFMS("DA")=GECSDATA
59 Q
60SETAM ;
61 N DIC S DIC="^PRC(442,"_+PO_",6,",DIC(0)="MNZ",X=PRCFA("AMEND#")
62 D ^DIC I +Y>0 S PO(6)=Y(0),PO(6,1)=^PRC(442,+PO,6,PRCFA("AMEND#"),1)
63 Q
64T1358 ; 1358 Error Processing when MOP = MISC OBL(1358)
65 I $D(PRCFA("ERTYP")),PRCFA("ERTYP")'="MISCOBL" W !! D MSG5^PRCFFERM H 3 Q
66 D STATR1^PRCFFERU(2)
67 D GENDIQ^PRCFFU7(442,+POIEN,".07","I","")
68 S (OB,DA)=$G(PRCTMP(442,+POIEN,".07","I"))
69 D NODE^PRCS58OB(DA,.TRNODE)
70 I '$D(PRC("CP")) S PRC("CP")=$P(TRNODE(0),"-",4)
71 S X=$P($G(RESP),U) I X D
72 .D PAUSE1^PRCFFERU
73 .S IOP="HOME" D ^%ZIS,^PRCE58P0
74 .Q
75 W ! S RETRAN=$$RETRANS^PRCFFERU(.RETRAN)
76 S X=$P($G(RETRAN),U) I 'X D MSG4^PRCFFERM H 3 Q
77T13581 D
78 .S PRCFA("RETRAN")=1,DA=OB
79 .I '$D(PRC("FY")) D
80 ..N FYQ S FYQ=$$FYQ^PRCFFERU(.FYQ)
81 ..S PRC("FY")=$P(FYQ,U),PRC("QTR")=$P(FYQ,U,3)
82 ..Q
83 .I '$D(PRC("PARAM")) S PRC("PARAM")=$$NODE^PRC0B("^PRC(411,PRC(""SITE""),",0)
84 .N PRCRGS,MODDOC
85 .S MODDOC=$P($G(PRCFA("GECS")),"^",3)
86 .S PRCRGS=$S(MODDOC="":1,MODDOC]"":2)
87 .I MODDOC="" D SC^PRCESOE Q
88 .I MODDOC]"" D Q
89 ..N RBLD S RBLD=$G(GECSDATA(2100.1,GECSDATA,26,"E"))
90 ..I RBLD]"" S Y=$P(RBLD,"/",4)
91 ..I RBLD="" D
92 ...S PATNUM=$$STRIP^PRCFFERU(PATNUM)
93 ...S Y=$O(^PRCS(410,"D",PATNUM,0))
94 ...Q
95 ..W ! D RETRAN^PRCEADJ1 Q
96 Q
97 ;
98SET1358 S FMSSEC=$$SEC1^PRC0C(PRC("SITE"))
99 S DESC="1358 Obligation Rebuild/Transmit"
100 S:MODDOC]"" DESC="1358 Obligation Adjustment Rebuild/Transmit"
101 D REBUILD^GECSUFM1(GECSDATA,"I",FMSSEC,"Y",DESC)
102 S GECSFMS("DA")=GECSDATA
103 Q
104 ;
105 ; get current txn's type, action & amendment/adjustment #
106GECS N LOOP,NODE,X
107 S LOOP=0,PRCFA("GECS")=""
108 F S LOOP=$O(^PRC(442,+PO,10,LOOP)) Q:LOOP'>0!($G(PRCFA("GECS"))'="") D
109 . S NODE=^PRC(442,+PO,10,LOOP,0)
110 . I GECSDATA(2100.1,GECSDATA,.01,"E")=$P(NODE,"^",4) D
111 . . S PRCFA("GECS")=$E(NODE,1,2)_"^"_$E(NODE,4)_"^"_$P(NODE,"^",10)_"^"_$P(NODE,"^",9)
112 . . I MOP=21 S $P(PRCFA("GECS"),"^",3)=$P(NODE,"^",11) ; 1358s
113 Q
114 ;
115 ; find all FMS txn associated with the amendment/adjustment #
116 ; PO = purchase order ien
117 ; VER = amendment/adjustment #
118 ; MOP = method of processing
119 ; returns DOC IDs for SO, AR.E, AR.M codesheets on same amend/adjust#
120GETTXNS(PO,VER,MOP) N LOOP,NODE,PRCSOE,PRCSOM,PRCARE,PRCARM,PRCCAN,TYPE,X
121 S TYPE=10 I MOP=21 S TYPE=11 ; piece holding amend/adjust#
122 S LOOP=0,(PRCSOE,PRCSOM,PRCARE,PRCARM,PRCCAN)=""
123 F S LOOP=$O(^PRC(442,+PO,10,LOOP)) Q:LOOP'>0 D
124 . S NODE=^PRC(442,+PO,10,LOOP,0)
125 . I $E(NODE,1,4)="SO.E",VER=$P(NODE,"^",TYPE) S PRCSOE=$P(NODE,"^",4)
126 . I $E(NODE,1,4)="SO.M",VER=$P(NODE,"^",TYPE) S PRCSOM=$P(NODE,"^",4)
127 . I $E(NODE,1,4)="AR.E",VER=$P(NODE,"^",TYPE) S PRCARE=$P(NODE,"^",4)
128 . I $E(NODE,1,4)="AR.M",VER=$P(NODE,"^",TYPE) S PRCARM=$P(NODE,"^",4)
129 . I $E(NODE,4)="X",VER=$P(NODE,"^",TYPE) S PRCCAN=1 ; canceled amend#
130 S X=PRCSOE_"^"_PRCSOM_"^"_PRCARE_"^"_PRCARM_"^"_PRCCAN
131 Q X
132 ;
133 ;
134 ; Compares transaction types passed to string of existing transactions
135 ; returns .01 field of file 2100.1 if transaction type is in string
136 ; zero, if types are not in string
137 ;
138 ; TXNTP = Transaction Type
139 ; TXNAC = Transaction Action
140 ; STRING (Of 2100.1 doc id's) = SOE ^ SOM ^ ARE ^ ARM ^ flag for cancel
141 ;
142NEWCHK(TXNTP,TXNAC,STRING) N DOCID
143 S DOCID=0
144 I $P(TXNTP,"^",5)'=1 D ; amend# canceled
145 . I $P(TXNTP,":")="SO",TXNAC="E",$P(STRING,"^",1)]"" S DOCID=$P(STRING,"^",1)
146 . I $P(TXNTP,":")="SO",TXNAC="M",$P(STRING,"^",2)]"" S DOCID=$P(STRING,"^",2)
147 . I $P(TXNTP,":")="AR",TXNAC="E",$P(STRING,"^",3)]"" S DOCID=$P(STRING,"^",3)
148 . I $P(TXNTP,":")="AR",TXNAC="M",$P(STRING,"^",4)]"" S DOCID=$P(STRING,"^",4)
149 Q DOCID
150 ;
151 ; Check the selected transaction
152 ; if unavailable, give message & return '^'
153 ; if available, set up GECSDATA array and return 1
154SWITCH(DOCID,MP,GECSDATA) ;
155 N STATUS,X
156 D EN^DDIOL("Document exists for "_DOCID_". Attempting to rebuild.")
157 D EN^DDIOL(" ")
158 S STATUS=$$STATUS^GECSSGET(DOCID)
159 I "RENT"'[$E(STATUS) D
160 . D EN^DDIOL("Unable to rebuild now -- document has status of "_STATUS_".")
161 . S X=$S($E(DOCID,1,2)="AR":"AR",MP=21:"SO",1:"MO/SO")
162 . D EN^DDIOL("Please rebuild "_DOCID_" later using the "_X_" option.")
163 . S X="^"
164 I "RENT"[$E(STATUS) D
165 . D DATA^GECSSGET(DOCID,0)
166 . D EN^DDIOL("Rebuild will continue using "_DOCID_".")
167 . S X=1
168 Q X
169 ;
170OUT K GECSDATA,FMSNO,STATUS,DIC,FMSSEC,DESC
171 Q
172SCREEN ; Control screen display
173 I $D(IOF) W @IOF
174HDR ; Write Option Header
175 I $D(XQY0) W IOINHI,$P(XQY0,U,2),IOINORM
176 Q
Note: See TracBrowser for help on using the repository browser.