| [613] | 1 | PRC0E ;WISC/PLT-FMS Document Inquiry Utility ;12/16/94 12:50
|
|---|
| 2 | V ;;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
|
|---|
| 10 | EN(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: ")
|
|---|
| 14 | Q1 S PRCF("X")="AS" D ^PRCFSITE G:'% EXIT
|
|---|
| 15 | Q2 ;
|
|---|
| 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
|
|---|
| 20 | Q3 ;
|
|---|
| 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 | ;
|
|---|
| 41 | EXIT 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
|
|---|
| 48 | SOAR(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
|
|---|
| 67 | SOARA 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)
|
|---|
| 70 | SOARQ K Y
|
|---|
| 71 | SOARQ1 Q
|
|---|
