86 lines
3.9 KiB
Mathematica
86 lines
3.9 KiB
Mathematica
PRCUFCB ;WISC/SJG-FMS MO3 SEGMENT FOR CONVERSION ONLY ;11/29/93 09:45
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
; Routine is modification of PRCFFU21 for conversion processing
|
|
MO3 ;BUILD 'MO3' SEGMENT
|
|
; 7 - DELIVERY DATE (FILE 442)
|
|
; 7.2 - ESTIMATED COST (FILE 442)
|
|
; 9.2 - PROMPT PAYMENT TERMS (FILE 442)
|
|
; 8.3 - PURCHASE METHOD (442.12)
|
|
; 91 - TOTAL AMOUNT (FILE 442)
|
|
; 92 - NET AMOUNT (FILE 442)
|
|
; 5 - VENDOR (FILE 442)
|
|
; .07 - PRIMARY 2237 REQUEST (FILE 442)
|
|
; 13 - VENDOR CONTRACT NUMBER (FILE 410)
|
|
; 21 - DATE COMMITTED (FILE 410)
|
|
; 33 - END DATE FOR 1358 (FILE 410)
|
|
; 34 - AUTO ACCRUE (FILE 410)
|
|
;
|
|
MO3A N SEG,DELDATE,FMSYR,FMSMO,FMSDAY,PPT,PM,TOT,CONT,START,VENID,PRIMREQ,VENCONT,CONTIEN,CONTEND,CONTBEG
|
|
S TMPLINE=TMPLINE+1,SEG="MO3^^^^^^^01"
|
|
K PRCTMP N DA S DIC=442,DR=".07;5;7.2;7;8.3;91;92",DA=+PO,DIQ="PRCTMP(",DIQ(0)="IE",DR(442.12)=".01",DA(442.12)=1 D EN^DIQ1 K DIC,DIQ,DR
|
|
MO3B D
|
|
.I TYCODE="M" Q:(PRCFA("DEL")="")&(PRCFA("DELSCH")="")
|
|
.S DELDATE=PRCTMP(442,+PO,7,"I")
|
|
.S DELDATE=$$DELSCH^PRCFFU5(.DELDATE)
|
|
.S X1=BEGDATE,X2=DELDATE D ^%DTC I X>0 S DELDATE=BEGDATE
|
|
.D DATE(DELDATE,.A,.B,.C) S DELDATE=FMSYR_U_FMSMO_U_FMSDAY
|
|
.S $P(SEG,U,9)=DELDATE
|
|
MO3C I TRCODE="MO" D
|
|
.S PM=$G(PRCTMP(442.12,1,.01,"I"))
|
|
.S CONT="" I $D(^PRC(442,+PO,2,"AC"))\10 S START="",CONT=$O(^PRC(442,+PO,2,"AC",START))
|
|
.I TYCODE="E" S:PRCFMO("G/N")="G" TOT=$G(PRCTMP(442,+PO,91,"E")) S:PRCFMO("G/N")="N" TOT=$G(PRCTMP(442,+PO,92,"E")) S TOT=$FN(TOT,"",2),$P(SEG,U,27)=TOT
|
|
.I TYCODE="M" D
|
|
..Q:'$D(PRCFCHG("BOC"))
|
|
..S TOT=$FN(TOTAMT,"",2),$P(SEG,U,27)=TOT
|
|
.I $G(CONT) I TRCODE'="MO" S $P(SEG,U,33)=$E(CONT,1,10)
|
|
MO3D I TRCODE="SO" D
|
|
.S VENID=$G(PRCTMP(442,+PO,5,"I")),PRIMREQ=$G(PRCTMP(442,+PO,.07,"I"))
|
|
.S PRCFA("AUTOACC")=""
|
|
.I PRIMREQ]"" D
|
|
..N DA S DA=+PRIMREQ,DIC=410,DR="13;21;33;34;52",DIQ="PRCTMP(",DIQ(0)="IEN" D EN^DIQ1 K DIC,DIQ,DR
|
|
..S PRCFA("AUTOACC")=$E($G(PRCTMP(410,+PRIMREQ,34,"E")),1)
|
|
..I TYCODE="M" D
|
|
...N POIEN S POIEN=$G(PRCTMP(410,PRIMREQ,52,"I"))
|
|
...I POIEN]"" D
|
|
....N ORGIEN S ORGIEN=$G(PRCTMP(442,POIEN,.07,"I"))
|
|
....D GENDIQ^PRCFFU7(410,ORGIEN,"11;13;21;33;34","IEN","")
|
|
....S PRCFA("AUTOACC")=$E($G(PRCTMP(410,ORGIEN,34,"E")),1)
|
|
....Q
|
|
...Q
|
|
..I PRCFA("AUTOACC")="" S PRCFA("AUTOACC")="N"
|
|
..S VENCONT=$G(PRCTMP(410,+PRIMREQ,13,"E"))
|
|
..I VENID]""&(VENCONT]"")&($G(PRCTMP(410,+PRIMREQ,33,"I"))="") D
|
|
...S DIC="^PRC(440,"_VENID_",4,",DIC(0)="MNQZ",X=VENCONT D ^DIC K DIC
|
|
...S CONTIEN=+Y
|
|
...N DA S DIC=440,DR=6,DA=+VENID,DIQ="PRCTMP(",DIQ(0)="IEN",DR(440.03)=".5;1",DA(440.03)=CONTIEN D EN^DIQ1 K DIC,DIQ,DR
|
|
...S CONTEND=$G(PRCTMP(440.03,CONTIEN,1,"I")) I CONTEND]"" D DATE(CONTEND,.A,.B,.C) S CONTEND=FMSYR_U_FMSMO_U_FMSDAY,$P(SEG,U,9)=CONTEND
|
|
...S CONTBEG=$G(PRCTMP(440.03,CONTIEN,.5,"I")) I CONTBEG]"" D DATE(CONTBEG,.A,.B,.C) S CONTBEG=FMSYR_U_FMSMO_U_FMSDAY,$P(SEG,U,18)=CONTBEG
|
|
..I $G(PRCTMP(410,+PRIMREQ,33,"I"))]"" D
|
|
...S ENDDATE=$G(PRCTMP(410,+PRIMREQ,33,"I")) I ENDDATE]"" D DATE(ENDDATE,.A,.B,.C) S ENDDATE=FMSYR_U_FMSMO_U_FMSDAY,$P(SEG,U,9)=ENDDATE
|
|
...S BEGDATE=$G(PRCTMP(410,+PRIMREQ,21,"I")) I PRCFA("AUTOACC")["Y" I BEGDATE]"" D DATE(BEGDATE,.A,.B,.C) S BEGDATE=FMSYR_U_FMSMO_U_FMSDAY,$P(SEG,U,18)=BEGDATE
|
|
...Q
|
|
..Q
|
|
.I TYCODE="E" D
|
|
..I PRCFA("MP")=21 S TOT=$G(PRCTMP(442,+PO,91,"E")),TOT=$FN(TOT,"",2),$P(SEG,U,27)=TOT
|
|
..I PRCFA("MP")=1!(PRCFA("MP")=8)!(PRCFA("MP")=2) S TOT=$G(PRCTMP(442,+PO,92,"E")),TOT=$FN(TOT,"",2),$P(SEG,U,27)=TOT
|
|
.I TYCODE="M" D
|
|
..I PRCFA("MP")=21 S TOT=$G(PRCTMP(442,+PO,7.2,"E")),TOT=$FN(TOT,"",2),$P(SEG,U,27)=TOT
|
|
..I PRCFA("MP")=2 Q:'$D(PRCFCHG("BOC")) S TOT=$FN(TOTAMT,"",2),$P(SEG,U,27)=TOT
|
|
.I $G(VENCONT) S $P(SEG,U,33)=$E(VENCONT,1,10)
|
|
S ^TMP($J,"PRCMO",INT,TMPLINE)=SEG_"^~" K PRCTMP
|
|
Q
|
|
;
|
|
DATE(X,A,B,C) ;
|
|
S FMSYR=$E(X,2,3),FMSMO=$E(X,4,5),FMSDAY=$E(X,6,7)
|
|
Q
|
|
DATE1(X) ;
|
|
Q $E(X,4,5)_$E(X,6,7)_$E(X,2,3)
|
|
Q
|
|
ASKDATE(X) ;
|
|
N Y,ASKDATE
|
|
S %DT="AEX",%DT("A")=X D ^%DT
|
|
S ASKDATE=Y K %DT
|
|
Q ASKDATE
|