Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRC0E

PRC0E.m

Go to the documentation of this file. 
  1. PRC0E ;WISC/PLT-FMS Document Inquiry Utility ;12/16/94  12:50
  1. V ;;5.1;IFCAP;;Oct 20, 2000
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  QUIT  ;invalid entry
  1.  ;
  1.  ;PRCA data ^1=txn type:description;txn type...,^2=select document text (see Q3)
  1.  ;           ^2=select document text (see Q3), ^status codes (option)
  1.  ;PRCB=executed mumps codes
  1.  ; with X given data ^1=station, ^2=txn type, ^3=document id, ^4=file 2100.1 record id
  1. EN(PRCA,PRCB) ;Display FMS document
  1.  N PRC,PRCRI,PRCID,PRCTX,PRCF,PRCPT
  1.  N GECSDATA
  1.  S PRCPT=$S($P(PRCA,"^",2)]"":$P(PRCA,"^",2),1:"Obligation/Common Number: ")
  1. Q1 S PRCF("X")="AS" D ^PRCFSITE G:'% EXIT
  1. Q2 ;
  1.  D SC^PRC0A(.X,.Y,"Select Transaction Type","OM^"_$P(PRCA,"^"),"")
  1.  G:Y=""!(X="")!(X["^") EXIT
  1.  S PRCTX=Y
  1.  K X,Y
  1. Q3 ;
  1.  D EN^DDIOL(" ")
  1.  S X=$$SELECT^GECSSTAA(PRCTX,PRC("SITE"),$TR($P(PRCA,"^",3),"~","^"),"",$P(PRCA,"^",2))
  1.  I $D(DTOUT)!$D(DUOUT) K DTOUT,DUOUT G EXIT
  1.  G:'X Q2
  1.  S X=$P(X,U,2)
  1.  D DATA^GECSSGET(X,0)
  1.  I '$G(GECSDATA) D EN^DDIOL(PRCPT_" NOT found!") G Q3
  1.  S PRCRI(2100.1)=GECSDATA,PRCID=GECSDATA(2100.1,PRCRI(2100.1),.01,"E")
  1.  D EN^DDIOL(" "),EN^DDIOL($J("FMS Document: ",15)_PRCID)
  1.  D EN^DDIOL($J("Description: ",15)_GECSDATA(2100.1,PRCRI(2100.1),4,"E"))
  1.  D EN^DDIOL($J("Status: ",15)_GECSDATA(2100.1,PRCRI(2100.1),3,"E"))
  1.  D EN^DDIOL($J("Created: ",15)_GECSDATA(2100.1,PRCRI(2100.1),2,"E"))
  1.  S X=PRC("SITE")_"^"_PRCTX_"^"_PRCID_"^"_PRCRI(2100.1)
  1.  ;RESERVED FOR ERROR MESSAGE DISPLAY
  1.  I $G(PRCB)]"" S Y=PRCB D
  1.  . N PRCA,PRCB,PRC,PRCRI,PRCID,PRCTX,PRCF,PRCPT
  1.  . X Y
  1.  K GECSDATA,X,Y
  1.  G Q3
  1.  ;
  1. EXIT K X,Y
  1.  QUIT
  1.  ;
  1.  ; If this is a prior year transaction, ask if it should be an SO or AR
  1.  ; PATDA = ien for document being processed
  1.  ; PRCFATT = SO or AR
  1.  ; PRCMSG = Flag indicating what prompt to use
  1. SOAR(PATDA,PRCFATT,PRCMSG) N PRCFCFY,PRCFY,PRCFX,PRCFZ,PRCMSGT,SD
  1.  S SD=$G(^PRC(411,"A IFCAP-Wide Parameters","SO 2 AR Date")) ;  FMS accrual date
  1.  S PRCFCFY=$E(DT,1,3)+1700 ; CURRENT YEAR
  1.  ; calculate the effective FMS fiscal year
  1.  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
  1.  S PRCFY="",PRCFX=0
  1.  ; get acctg pd/oblig date for the first SO.E transaction on this record
  1.  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
  1.  . S PRCFY=$S($P(PRCFZ,U,13)]"":$P(PRCFZ,U,13),1:$P(PRCFZ,U,12))
  1.  . S PRCFY=$E(PRCFY,1,3)+1700+$E(PRCFY,4)
  1.  S PRCFX=1 ; flag to assume document is prior year
  1.  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)
  1.  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)
  1.  I PRCFX=0 G SOARQ1 ; do not prompt user for this document
  1.  ;
  1.  ; calculate whether AR or SO should be used
  1.  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
  1.  ;
  1.  ; ask user
  1. SOARA S PRCMSGT=$S(PRCMSG=1:"SEND TO FMS AS AN: ",PRCMSG=2:"POST AGAINST AN FMS: ")
  1.  D SC^PRC0A("",.Y,PRCMSGT,"AOM^AR:RECEIVER ACCRUAL DOCUMENT;SO:SERVICE ORDER DOCUMENT",PRCFATT)
  1.  S PRCFATT=$P(Y,":",1)
  1. SOARQ K Y
  1. SOARQ1 Q