PRC0E ;WISC/PLT-FMS Document Inquiry Utility ;12/16/94 12:50
V ;;5.1;IFCAP;;Oct 20, 2000
;Per VHA Directive 10-93-142, this routine should not be modified.
QUIT ;invalid entry
;
;PRCA data ^1=txn type:description;txn type...,^2=select document text (see Q3)
; ^2=select document text (see Q3), ^status codes (option)
;PRCB=executed mumps codes
; with X given data ^1=station, ^2=txn type, ^3=document id, ^4=file 2100.1 record id
EN(PRCA,PRCB) ;Display FMS document
N PRC,PRCRI,PRCID,PRCTX,PRCF,PRCPT
N GECSDATA
S PRCPT=$S($P(PRCA,"^",2)]"":$P(PRCA,"^",2),1:"Obligation/Common Number: ")
Q1 S PRCF("X")="AS" D ^PRCFSITE G:'% EXIT
Q2 ;
D SC^PRC0A(.X,.Y,"Select Transaction Type","OM^"_$P(PRCA,"^"),"")
G:Y=""!(X="")!(X["^") EXIT
S PRCTX=Y
K X,Y
Q3 ;
D EN^DDIOL(" ")
S X=$$SELECT^GECSSTAA(PRCTX,PRC("SITE"),$TR($P(PRCA,"^",3),"~","^"),"",$P(PRCA,"^",2))
I $D(DTOUT)!$D(DUOUT) K DTOUT,DUOUT G EXIT
G:'X Q2
S X=$P(X,U,2)
D DATA^GECSSGET(X,0)
I '$G(GECSDATA) D EN^DDIOL(PRCPT_" NOT found!") G Q3
S PRCRI(2100.1)=GECSDATA,PRCID=GECSDATA(2100.1,PRCRI(2100.1),.01,"E")
D EN^DDIOL(" "),EN^DDIOL($J("FMS Document: ",15)_PRCID)
D EN^DDIOL($J("Description: ",15)_GECSDATA(2100.1,PRCRI(2100.1),4,"E"))
D EN^DDIOL($J("Status: ",15)_GECSDATA(2100.1,PRCRI(2100.1),3,"E"))
D EN^DDIOL($J("Created: ",15)_GECSDATA(2100.1,PRCRI(2100.1),2,"E"))
S X=PRC("SITE")_"^"_PRCTX_"^"_PRCID_"^"_PRCRI(2100.1)
;RESERVED FOR ERROR MESSAGE DISPLAY
I $G(PRCB)]"" S Y=PRCB D
. N PRCA,PRCB,PRC,PRCRI,PRCID,PRCTX,PRCF,PRCPT
. X Y
K GECSDATA,X,Y
G Q3
;
EXIT K X,Y
QUIT
;
; If this is a prior year transaction, ask if it should be an SO or AR
; PATDA = ien for document being processed
; PRCFATT = SO or AR
; PRCMSG = Flag indicating what prompt to use
SOAR(PATDA,PRCFATT,PRCMSG) N PRCFCFY,PRCFY,PRCFX,PRCFZ,PRCMSGT,SD
S SD=$G(^PRC(411,"A IFCAP-Wide Parameters","SO 2 AR Date")) ; FMS accrual date
S PRCFCFY=$E(DT,1,3)+1700 ; CURRENT YEAR
; calculate the effective FMS fiscal year
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
S PRCFY="",PRCFX=0
; get acctg pd/oblig date for the first SO.E transaction on this record
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
. S PRCFY=$S($P(PRCFZ,U,13)]"":$P(PRCFZ,U,13),1:$P(PRCFZ,U,12))
. S PRCFY=$E(PRCFY,1,3)+1700+$E(PRCFY,4)
S PRCFX=1 ; flag to assume document is prior year
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)
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)
I PRCFX=0 G SOARQ1 ; do not prompt user for this document
;
; calculate whether AR or SO should be used
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
;
; ask user
SOARA S PRCMSGT=$S(PRCMSG=1:"SEND TO FMS AS AN: ",PRCMSG=2:"POST AGAINST AN FMS: ")
D SC^PRC0A("",.Y,PRCMSGT,"AOM^AR:RECEIVER ACCRUAL DOCUMENT;SO:SERVICE ORDER DOCUMENT",PRCFATT)
S PRCFATT=$P(Y,":",1)
SOARQ K Y
SOARQ1 Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRC0E 3328 printed Apr 09, 2024@21:20:10 Page 2
PRC0E ;WISC/PLT-FMS Document Inquiry Utility ;12/16/94 12:50
V ;;5.1;IFCAP;;Oct 20, 2000
+1 ;Per VHA Directive 10-93-142, this routine should not be modified.
+2 ;invalid entry
QUIT
+3 ;
+4 ;PRCA data ^1=txn type:description;txn type...,^2=select document text (see Q3)
+5 ; ^2=select document text (see Q3), ^status codes (option)
+6 ;PRCB=executed mumps codes
+7 ; with X given data ^1=station, ^2=txn type, ^3=document id, ^4=file 2100.1 record id
EN(PRCA,PRCB) ;Display FMS document
+1 NEW PRC,PRCRI,PRCID,PRCTX,PRCF,PRCPT
+2 NEW GECSDATA
+3 SET PRCPT=$SELECT($PIECE(PRCA,"^",2)]"":$PIECE(PRCA,"^",2),1:"Obligation/Common Number: ")
Q1 SET PRCF("X")="AS"
DO ^PRCFSITE
if '%
GOTO EXIT
Q2 ;
+1 DO SC^PRC0A(.X,.Y,"Select Transaction Type","OM^"_$PIECE(PRCA,"^"),"")
+2 if Y=""!(X="")!(X["^")
GOTO EXIT
+3 SET PRCTX=Y
+4 KILL X,Y
Q3 ;
+1 DO EN^DDIOL(" ")
+2 SET X=$$SELECT^GECSSTAA(PRCTX,PRC("SITE"),$TRANSLATE($PIECE(PRCA,"^",3),"~","^"),"",$PIECE(PRCA,"^",2))
+3 IF $DATA(DTOUT)!$DATA(DUOUT)
KILL DTOUT,DUOUT
GOTO EXIT
+4 if 'X
GOTO Q2
+5 SET X=$PIECE(X,U,2)
+6 DO DATA^GECSSGET(X,0)
+7 IF '$GET(GECSDATA)
DO EN^DDIOL(PRCPT_" NOT found!")
GOTO Q3
+8 SET PRCRI(2100.1)=GECSDATA
SET PRCID=GECSDATA(2100.1,PRCRI(2100.1),.01,"E")
+9 DO EN^DDIOL(" ")
DO EN^DDIOL($JUSTIFY("FMS Document: ",15)_PRCID)
+10 DO EN^DDIOL($JUSTIFY("Description: ",15)_GECSDATA(2100.1,PRCRI(2100.1),4,"E"))
+11 DO EN^DDIOL($JUSTIFY("Status: ",15)_GECSDATA(2100.1,PRCRI(2100.1),3,"E"))
+12 DO EN^DDIOL($JUSTIFY("Created: ",15)_GECSDATA(2100.1,PRCRI(2100.1),2,"E"))
+13 SET X=PRC("SITE")_"^"_PRCTX_"^"_PRCID_"^"_PRCRI(2100.1)
+14 ;RESERVED FOR ERROR MESSAGE DISPLAY
+15 IF $GET(PRCB)]""
SET Y=PRCB
Begin DoDot:1
+16 NEW PRCA,PRCB,PRC,PRCRI,PRCID,PRCTX,PRCF,PRCPT
+17 XECUTE Y
End DoDot:1
+18 KILL GECSDATA,X,Y
+19 GOTO Q3
+20 ;
EXIT KILL X,Y
+1 QUIT
+2 ;
+3 ; If this is a prior year transaction, ask if it should be an SO or AR
+4 ; PATDA = ien for document being processed
+5 ; PRCFATT = SO or AR
+6 ; PRCMSG = Flag indicating what prompt to use
SOAR(PATDA,PRCFATT,PRCMSG) NEW PRCFCFY,PRCFY,PRCFX,PRCFZ,PRCMSGT,SD
+1 ; FMS accrual date
SET SD=$GET(^PRC(411,"A IFCAP-Wide Parameters","SO 2 AR Date"))
+2 ; CURRENT YEAR
SET PRCFCFY=$EXTRACT(DT,1,3)+1700
+3 ; calculate the effective FMS fiscal year
+4 ; if OCT,NOV,DEC, increment year if today is after the FMS accrual date
IF $EXTRACT(DT,4)=1
SET PRCFCFY=PRCFCFY+$SELECT(SD>0:DT>SD,1:1)
+5 SET PRCFY=""
SET PRCFX=0
+6 ; get acctg pd/oblig date for the first SO.E transaction on this record
+7 FOR
SET PRCFX=$ORDER(^PRC(442,PATDA,10,PRCFX))
if +PRCFX'=PRCFX
QUIT
SET PRCFZ=$GET(^PRC(442,PATDA,10,PRCFX,0))
IF $PIECE($PIECE(PRCFZ,U),".",1,2)="SO.E"
Begin DoDot:1
+8 SET PRCFY=$SELECT($PIECE(PRCFZ,U,13)]"":$PIECE(PRCFZ,U,13),1:$PIECE(PRCFZ,U,12))
+9 SET PRCFY=$EXTRACT(PRCFY,1,3)+1700+$EXTRACT(PRCFY,4)
End DoDot:1
QUIT
+10 ; flag to assume document is prior year
SET PRCFX=1
+11 ; document will not require AR/SO calculation (either after 10/1 & before FMS accrual date or doc is current fiscal year)
IF PRCFCFY'>PRCFY
SET PRCFX=0
+12 ; force user to be prompted if document is prior year (after 10/1 but not after FMS accrual date)
IF PRCFX=0
IF PRCFCFY=PRCFY
IF DT'>SD
IF $EXTRACT(DT,4)=1
GOTO SOARA
+13 ; do not prompt user for this document
IF PRCFX=0
GOTO SOARQ1
+14 ;
+15 ; calculate whether AR or SO should be used
+16 ; set txn type to AR if auto accrue flag is yes
IF PRCFX=1
IF $PIECE($GET(^PRC(442,PATDA,23)),U,6)'=0
SET PRCFATT="AR"
+17 ;
+18 ; ask user
SOARA SET PRCMSGT=$SELECT(PRCMSG=1:"SEND TO FMS AS AN: ",PRCMSG=2:"POST AGAINST AN FMS: ")
+1 DO SC^PRC0A("",.Y,PRCMSGT,"AOM^AR:RECEIVER ACCRUAL DOCUMENT;SO:SERVICE ORDER DOCUMENT",PRCFATT)
+2 SET PRCFATT=$PIECE(Y,":",1)
SOARQ KILL Y
SOARQ1 QUIT
