source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCFFU.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: 5.8 KB
Line 
1PRCFFU ;WISC/SJG-CONTINUATION OF OBLIGATION PROCESSING ;7/21/93 13:51
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 point
6OKAY ;
7 S DIR(0)="Y",DIR("A",1)="The information listed above is recorded on this "_PRCFA("IDES")_"."
8 S DIR("A")="Is the above information correct",DIR("B")="YES"
9 S DIR("?")="Enter 'NO' or 'N' to edit the Cost Center or BOC."
10 S DIR("?",1)="Enter '^' to exit this option."
11 S DIR("?",2)="Enter 'YES' or 'Y' or 'RETURN' to continue processing this obligation."
12 D ^DIR K DIR
13 QUIT
14 ;
15OKAY2 ;
16 S DIR(0)="Y",DIR("A")="OK to Continue",DIR("B")="YES"
17 S DIR("?")="Enter 'NO' or 'N' or '^' to exit this option."
18 S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to continue processing this obligation."
19 D ^DIR K DIR
20 QUIT
21 ;
22EDIT ; Set up PRCFMO array to indicate required FMS fields
23 S PARAM1="^"_PRC("SITE")_"^"_+$P(PO(0),U,3)_"^"_PRC("FY")_"^"_PRCFA("BBFY")
24 ; build PRCFMO array to use when creating LIN string of FMS transaction
25 ; PARAM1=^STATION^FCP^FY^BBFY
26 ; SPE means spending documents
27 D DOCREQ^PRC0C(PARAM1,"SPE","PRCFMO")
28 S PRCFMO("G/N")=$P(PRCFMO,U,12)
29 QUIT
30 ;
31GO ; Prompt user for final go-ahead for the document creation
32 S PRCFA("FDES")=$S(PRCFA("TT")="MO":"Miscellaneous Order (MO)",PRCFA("TT")="SO":"Service (SO) Order",PRCFA("TT")="AR":"Receiver Accrual (AR)")
33 N POSIT S POSIT=$F(PRCFA("FDES"),"(")
34 S PRCFA("TYPE")=$E(PRCFA("FDES"),POSIT,POSIT+1)
35 S DIR(0)="Y"
36 S DIR("A")="Transmit this Document to FMS"
37 S DIR("B")="YES"
38 S DIR("A",1)=" "
39 S DIR("A",2)="This "_PRCFA("IDES")_" will now generate the "
40 S DIR("A",3)=$P(PRCFA("MOD"),U,3)_" "_PRCFA("FDES")_" Document. The "_PRCFA("TYPE")_" Document"
41 S DIR("A",4)="will be marked for transmission to FMS."
42 S DIR("A",5)=" "
43 S DIR("?")="Enter 'NO' or 'N' or '^' to exit this option."
44 S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to transmit this Document."
45 D ^DIR K DIR
46 QUIT
47 ;
48STACK(MOD) ; Create entry in GECS Stack File
49 I $D(PRCFA("CONVS")),PRCFA("CONVS")=1 G STACK1
50 I $D(PRCFA("CONVG")),PRCFA("CONVG")=1 G STACK1
51 W !!,"...now generating the FMS "
52 W $S(PRCFA("TT")="MO":"Miscellaneous Order (MO) Document",PRCFA("TT")="SO":"Service Order (SO) Document",PRCFA("TT")="AR":"Receiver Accrual (AR) Document",1:"Document")
53 W "...",! D WAIT^DICD
54STACK1 N FMSSYS,FMSSTA,FMSDOC,FMSTRA,FMSSEC,FMSMOD,FMSFCP,FMSDES
55 I $D(PRCFA("RETRAN")),PRCFA("RETRAN")=1 Q
56 K GECSUFMS("DA") ; delete current ien to get new ien
57 S FMSDES=PRCFA("IDES")
58 S FMSDOC=PRCFA("REF")
59 S FMSMOD=MOD
60 I PRCFA("TT")="AR" D
61 . S FMSDOC=FMSDOC_12
62 . S FMSMOD=1
63 S FMSSEC=$$SEC1^PRC0C(PRC("SITE"))
64 S FMSSTA=PRC("SITE")
65 S FMSSYS="I"
66 S FMSTRA=PRCFA("TT")
67 D CONTROL^GECSUFMS(FMSSYS,FMSSTA,FMSDOC,FMSTRA,FMSSEC,FMSMOD,"Y",FMSDES)
68 QUIT
69 ;
70OKAM ; Reader for prompt to approve amendment
71 S DIR(0)="Y"
72 S DIR("A",1)="The information listed above is recorded on this Purchase Order amendment."
73 S DIR("A")="Are you ready to approve and obligate this amendment"
74 S DIR("B")="YES"
75 S DIR("?")="Enter 'NO' or 'N' or '^' to exit this option."
76 S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to continue processing this amendment obligation."
77 D ^DIR K DIR
78 QUIT
79 ;
80OKAPP ; Reader for prompt that amendment has already been approved
81 S DIR(0)="Y"
82 S DIR("A",1)="This amendment has already been approved by Fiscal."
83 S DIR("A")="Are you sure that you wish to continue"
84 S DIR("B")="NO"
85 S DIR("?")="Enter 'YES' or 'Y' to continue."
86 S DIR("?",1)="Enter 'NO' or 'N' or '^' or 'RETURN' to exit this option."
87 D ^DIR K DIR
88 QUIT
89 ;
90OKPRT ; Reader to prompt user to print the amendment
91 S DIR(0)="Y"
92 S DIR("A")="Would you like to print this amendment"
93 S DIR("B")="YES"
94 S DIR("?")="Enter 'YES' or 'Y' or 'RETURN' to print this amendment."
95 S DIR("?",1)="Enter 'NO' or 'N' or '^' if printing in not desired."
96 D ^DIR K DIR
97 QUIT
98 ;
99REVIEW ; Reader to prompt user to review the PO before obligation
100 N LABEL S LABEL=$S((PRCFA("MP")=1)!(PRCFA("MP")=2):"Purchase Order",PRCFA("MP")=8:"Requisition",1:"Purchase Order")
101 S DIR(0)="Y"
102 S DIR("A")="Would you like to review the entire "_LABEL
103 S DIR("B")="YES"
104 S DIR("?")="Enter 'NO' or 'N' or '^' if the "_LABEL_" review is not necessary."
105 S DIR("?",1)="Enter 'YES' or 'Y' or 'RETURN' to display the "_LABEL_"."
106 D ^DIR K DIR
107 Q
108 ;
109 ; PO is the ien of the 443.6 file
110 ; AMNUM is the amendment number
111CHKAMEN(PO,AMNUM) ; checks PO completeness, looks for missing data
112 N CNT,J,INUM,CHNG,STARTFLG,TYPAM,MSG,PRPAYFLG
113 S CNT=0
114 S STARTFLG=0
115 S PRPAYFLG=0
116 F CHNG=0:0 S CHNG=$O(^PRC(443.6,+PO,6,AMNUM,3,CHNG)) Q:CHNG'>0 D
117 . S CHNG=^(CHNG,0)
118 . ;
119 . ;Has the data in any of the following fields been deleted?
120 . ;Ship To Address, Inv. Address, Prompt Pay. Terms, or F.O.B.Point.
121 . S TYPAM=$P($G(CHNG),U,2)
122 . I TYPAM=20,$P(^PRC(443.6,+PO,1),U,3)="" D
123 . . S MSG="Ship To Address."
124 . . S $P(^PRC(443.6,+PO,1),U,3)=$P(^PRC(442,+PO,1),U,3)
125 . I TYPAM=25,$P(^PRC(443.6,+PO,12),U,6)="" D
126 . . S MSG="Invoice Address."
127 . . S $P(^PRC(443.6,+PO,12),U,6)=$P(^PRC(442,+PO,12),U,6)
128 . I TYPAM=33,^PRC(443.6,+PO,5,0)="" D
129 . . S MSG="Prompt Payment Terms."
130 . . S ^PRC(443.6,+PO,5,0)=^PRC(442,+PO,5,0)
131 . . S I=0 F J=0:0 S I=$O(^PRC(443.6,+PO,5,I)) Q:I="" S ^PRC(443.6,+PO,5,I,0)=^PRC(442,+PO,5,I,0)
132 . . Q
133 . I TYPAM=35,$P(^PRC(443.6,+PO,1),U,6)="" D
134 . . S MSG="F.O.B. Point."
135 . . S $P(^PRC(443.6,+PO,1),U,6)=$P(^PRC(442,+PO,1),U,6)
136 . I $G(MSG)]"" D
137 . . I TYPAM=33&'PRPAYFLG!(TYPAM'=33) W !?10,"This amendment is missing it's ",MSG,"!" K MSG
138 . . I TYPAM=33 S PRPAYFLG=1
139 . . S STARTFLG=1
140 . Q
141 . ;
142 . I $P($P(CHNG,U,3),":",2)=40,($P($P(CHNG,U,3),";"))=1 S INUM=$P(CHNG,U,4) I $G(INUM)]"" D
143 . . ; for each item , check description
144 . . S J=0 S J=$O(^PRC(443.6,+PO,2,INUM,1,J)) I J>0&(^(J,0)="") D
145 . . . I CNT>22 N DIR S DIR(0)="E" D ^DIR S CNT=0
146 . . . W !,?10,"Line item ",INUM," is missing it's description!"
147 . . . S CNT=CNT+2,STARTFLG=1
148 . . . Q
149 . . Q
150 . Q
151 Q STARTFLG
Note: See TracBrowser for help on using the repository browser.