68 lines
2.5 KiB
Mathematica
68 lines
2.5 KiB
Mathematica
PRCFFU2 ;WISC/SJG-FMS MO2 SEGMENT ;11/29/93 09:45
|
|
V ;;5.1;IFCAP;;Oct 20, 2000
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
;
|
|
MO2(NODE,TYCODE) ;BUILD 'MO2' SEGMENT
|
|
; .1 - P.O. DATE FROM 442 .01 - NAME FROM 440
|
|
; 5 - VENDOR FROM 442 .06 - FEDERAL SOURCE FROM 440
|
|
; 6.4 - FOB POINT FROM 442 34 - FMS VENDOR CODE FROM 440
|
|
; 35 - ALT-ADDR-IND FROM 440
|
|
MO2A N SEG,FMSYR,FMSMO,FMSDAY,VEND,FMSVENCD,FMSVENNM,FMSPODAT,FMSFOB
|
|
S (FMSVENID,FMSVENCD,FMSVENNM,FMSFOB)=""
|
|
S TMPLINE=TMPLINE+1
|
|
K PRCTMP N DA S DIC=442,DR=".1;5;6.4",DA=+PO,DIQ="PRCTMP(",DIQ(0)="IE" D EN^DIQ1 K DIC,DIQ,DR
|
|
MO2B I (TRCODE="MO")&(("^1^3^4^7^8^26^"[("^"_PRCFA("MP")_"^"))) D
|
|
.S (BEGDATE,FMSPODAT,PODATE)=PRCFA("OBLDATE")
|
|
.D DATE(FMSPODAT,.A,.B,.C) S FMSPODAT=FMSYR_U_FMSMO_U_FMSDAY
|
|
MO2C I (TRCODE="SO")&(PRCFA("MP")=2) D
|
|
.S (BEGDATE,FMSPODAT,PODATE)=PRCFA("OBLDATE")
|
|
.D DATE(FMSPODAT,.A,.B,.C) S FMSPODAT=FMSYR_U_FMSMO_U_FMSDAY
|
|
MO2D I (TRCODE="SO")&(PRCFA("MP")=21) D
|
|
.I TYCODE="E" D
|
|
..S (BEGDATE,FMSPODAT,PODATE)=PRCFA("OBLDATE")
|
|
..S FMSPODAT=$E(PODATE,2,3)_U_$E(PODATE,4,5)_U_$E(PODATE,6,7)
|
|
..Q
|
|
.I TYCODE="M" D
|
|
..S (BEGDATE,FMSPODAT,PODATE)=PRCFA("OBLDATE")
|
|
..D DATE(FMSPODAT,.A,.B,.C) S FMSPODAT=FMSYR_U_FMSMO_U_FMSDAY
|
|
..Q
|
|
MO2E D
|
|
.I TYCODE="M" Q:'PRCFA("FOB")
|
|
.S (FMSFOB,FOB)=$G(PRCTMP(442,+PO,6.4,"I"))
|
|
.I FOB="" S (FMSFOB,FOB)="D"
|
|
MO2F D
|
|
.I TYCODE="M" Q:'PRCFA("VEND")
|
|
.S VEND=$G(PRCTMP(442,+PO,5,"I"))
|
|
.I VEND]"" D
|
|
..N DA S DIC=440,DR=".01;.06;34;35",DA=+VEND,DIQ="PRCTMP(",DIQ(0)="IE" D EN^DIQ1 K DIC,DIQ,DR
|
|
..S FMSVENID=$G(PRCTMP(440,VEND,34,"E"))
|
|
..S FMSVENCD=$G(PRCTMP(440,VEND,35,"E"))
|
|
..S FMSVENNM=$G(PRCTMP(440,VEND,.01,"E"))
|
|
..S FMSVENNM=$E(FMSVENNM,1,30)
|
|
..I FMSVENID="" D
|
|
...S FMSFED=$G(PRCTMP(440,VEND,.06,"I"))
|
|
...S FMSVENID=$S(FMSFED:"MISCG",'FMSFED:"MISCN")
|
|
.I VEND="" I TRCODE="SO" S FMSVENID="MISCN",(FMSVENCD,FMSVENNM)=""
|
|
MO2G S SEG="MO2^"_FMSPODAT
|
|
N ACCMO,ACCYR,ACCPD
|
|
S ACCPD=$P($G(PRCFA("ACCPD")),U),ACCMO=$E(ACCPD,1,2),ACCYR=$E(ACCPD,3,4)
|
|
S $P(SEG,U,5)=ACCMO,$P(SEG,U,6)=ACCYR,$P(SEG,U,10)=TYCODE
|
|
I FMSVENID]"" S $P(SEG,U,14)=FMSVENID
|
|
I FMSVENCD]"" S $P(SEG,U,15)=FMSVENCD
|
|
I (FMSVENID="MISCN")!(FMSVENID="MISCG") I FMSVENNM]"" S $P(SEG,U,16)=FMSVENNM
|
|
I FMSFOB]"" S $P(SEG,U,24)=FMSFOB
|
|
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
|