source: FOIAVistA/tag/r/IFCAP-PRC-PRX--PRCA--PRCN/PRC0E.m@ 1690

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

initial load of FOIAVistA 6/30/08 version
File size: 3.2 KB
Line 
1PRC0E ;WISC/PLT-FMS Document Inquiry Utility ;12/16/94 12:50
2V ;;5.1;IFCAP;;Oct 20, 2000
3 ;Per VHA Directive 10-93-142, this routine should not be modified.
4 QUIT ;invalid entry
5 ;
6 ;PRCA data ^1=txn type:description;txn type...,^2=select document text (see Q3)
7 ; ^2=select document text (see Q3), ^status codes (option)
8 ;PRCB=executed mumps codes
9 ; with X given data ^1=station, ^2=txn type, ^3=document id, ^4=file 2100.1 record id
10EN(PRCA,PRCB) ;Display FMS document
11 N PRC,PRCRI,PRCID,PRCTX,PRCF,PRCPT
12 N GECSDATA
13 S PRCPT=$S($P(PRCA,"^",2)]"":$P(PRCA,"^",2),1:"Obligation/Common Number: ")
14Q1 S PRCF("X")="AS" D ^PRCFSITE G:'% EXIT
15Q2 ;
16 D SC^PRC0A(.X,.Y,"Select Transaction Type","OM^"_$P(PRCA,"^"),"")
17 G:Y=""!(X="")!(X["^") EXIT
18 S PRCTX=Y
19 K X,Y
20Q3 ;
21 D EN^DDIOL(" ")
22 S X=$$SELECT^GECSSTAA(PRCTX,PRC("SITE"),$TR($P(PRCA,"^",3),"~","^"),"",$P(PRCA,"^",2))
23 I $D(DTOUT)!$D(DUOUT) K DTOUT,DUOUT G EXIT
24 G:'X Q2
25 S X=$P(X,U,2)
26 D DATA^GECSSGET(X,0)
27 I '$G(GECSDATA) D EN^DDIOL(PRCPT_" NOT found!") G Q3
28 S PRCRI(2100.1)=GECSDATA,PRCID=GECSDATA(2100.1,PRCRI(2100.1),.01,"E")
29 D EN^DDIOL(" "),EN^DDIOL($J("FMS Document: ",15)_PRCID)
30 D EN^DDIOL($J("Description: ",15)_GECSDATA(2100.1,PRCRI(2100.1),4,"E"))
31 D EN^DDIOL($J("Status: ",15)_GECSDATA(2100.1,PRCRI(2100.1),3,"E"))
32 D EN^DDIOL($J("Created: ",15)_GECSDATA(2100.1,PRCRI(2100.1),2,"E"))
33 S X=PRC("SITE")_"^"_PRCTX_"^"_PRCID_"^"_PRCRI(2100.1)
34 ;RESERVED FOR ERROR MESSAGE DISPLAY
35 I $G(PRCB)]"" S Y=PRCB D
36 . N PRCA,PRCB,PRC,PRCRI,PRCID,PRCTX,PRCF,PRCPT
37 . X Y
38 K GECSDATA,X,Y
39 G Q3
40 ;
41EXIT K X,Y
42 QUIT
43 ;
44 ; If this is a prior year transaction, ask if it should be an SO or AR
45 ; PATDA = ien for document being processed
46 ; PRCFATT = SO or AR
47 ; PRCMSG = Flag indicating what prompt to use
48SOAR(PATDA,PRCFATT,PRCMSG) N PRCFCFY,PRCFY,PRCFX,PRCFZ,PRCMSGT,SD
49 S SD=$G(^PRC(411,"A IFCAP-Wide Parameters","SO 2 AR Date")) ; FMS accrual date
50 S PRCFCFY=$E(DT,1,3)+1700 ; CURRENT YEAR
51 ; calculate the effective FMS fiscal year
52 I $E(DT,4)=1 S PRCFCFY=PRCFCFY+$S(SD>0:DT>SD,1:1) ; if OCT,NOV,DEC, increment year if today is after the FMS accrual date
53 S PRCFY="",PRCFX=0
54 ; get acctg pd/oblig date for the first SO.E transaction on this record
55 F S PRCFX=$O(^PRC(442,PATDA,10,PRCFX)) Q:+PRCFX'=PRCFX S PRCFZ=$G(^PRC(442,PATDA,10,PRCFX,0)) I $P($P(PRCFZ,U),".",1,2)="SO.E" D Q
56 . S PRCFY=$S($P(PRCFZ,U,13)]"":$P(PRCFZ,U,13),1:$P(PRCFZ,U,12))
57 . S PRCFY=$E(PRCFY,1,3)+1700+$E(PRCFY,4)
58 S PRCFX=1 ; flag to assume document is prior year
59 I PRCFCFY'>PRCFY S PRCFX=0 ; document will not require AR/SO calculation (either after 10/1 & before FMS accrual date or doc is current fiscal year)
60 I PRCFX=0,PRCFCFY=PRCFY,DT'>SD,$E(DT,4)=1 G SOARA ; force user to be prompted if document is prior year (after 10/1 but not after FMS accrual date)
61 I PRCFX=0 G SOARQ1 ; do not prompt user for this document
62 ;
63 ; calculate whether AR or SO should be used
64 I PRCFX=1,$P($G(^PRC(442,PATDA,23)),U,6)'=0 S PRCFATT="AR" ; set txn type to AR if auto accrue flag is yes
65 ;
66 ; ask user
67SOARA S PRCMSGT=$S(PRCMSG=1:"SEND TO FMS AS AN: ",PRCMSG=2:"POST AGAINST AN FMS: ")
68 D SC^PRC0A("",.Y,PRCMSGT,"AOM^AR:RECEIVER ACCRUAL DOCUMENT;SO:SERVICE ORDER DOCUMENT",PRCFATT)
69 S PRCFATT=$P(Y,":",1)
70SOARQ K Y
71SOARQ1 Q
Note: See TracBrowser for help on using the repository browser.