| 1 | PRCFFU2 ;WISC/SJG-FMS MO2 SEGMENT ;11/29/93 09:45
|
|---|
| 2 | V ;;5.1;IFCAP;;Oct 20, 2000
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | MO2(NODE,TYCODE) ;BUILD 'MO2' SEGMENT
|
|---|
| 6 | ; .1 - P.O. DATE FROM 442 .01 - NAME FROM 440
|
|---|
| 7 | ; 5 - VENDOR FROM 442 .06 - FEDERAL SOURCE FROM 440
|
|---|
| 8 | ; 6.4 - FOB POINT FROM 442 34 - FMS VENDOR CODE FROM 440
|
|---|
| 9 | ; 35 - ALT-ADDR-IND FROM 440
|
|---|
| 10 | MO2A N SEG,FMSYR,FMSMO,FMSDAY,VEND,FMSVENCD,FMSVENNM,FMSPODAT,FMSFOB
|
|---|
| 11 | S (FMSVENID,FMSVENCD,FMSVENNM,FMSFOB)=""
|
|---|
| 12 | S TMPLINE=TMPLINE+1
|
|---|
| 13 | 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
|
|---|
| 14 | MO2B I (TRCODE="MO")&(("^1^3^4^7^8^26^"[("^"_PRCFA("MP")_"^"))) D
|
|---|
| 15 | .S (BEGDATE,FMSPODAT,PODATE)=PRCFA("OBLDATE")
|
|---|
| 16 | .D DATE(FMSPODAT,.A,.B,.C) S FMSPODAT=FMSYR_U_FMSMO_U_FMSDAY
|
|---|
| 17 | MO2C I (TRCODE="SO")&(PRCFA("MP")=2) D
|
|---|
| 18 | .S (BEGDATE,FMSPODAT,PODATE)=PRCFA("OBLDATE")
|
|---|
| 19 | .D DATE(FMSPODAT,.A,.B,.C) S FMSPODAT=FMSYR_U_FMSMO_U_FMSDAY
|
|---|
| 20 | MO2D I (TRCODE="SO")&(PRCFA("MP")=21) D
|
|---|
| 21 | .I TYCODE="E" D
|
|---|
| 22 | ..S (BEGDATE,FMSPODAT,PODATE)=PRCFA("OBLDATE")
|
|---|
| 23 | ..S FMSPODAT=$E(PODATE,2,3)_U_$E(PODATE,4,5)_U_$E(PODATE,6,7)
|
|---|
| 24 | ..Q
|
|---|
| 25 | .I TYCODE="M" D
|
|---|
| 26 | ..S (BEGDATE,FMSPODAT,PODATE)=PRCFA("OBLDATE")
|
|---|
| 27 | ..D DATE(FMSPODAT,.A,.B,.C) S FMSPODAT=FMSYR_U_FMSMO_U_FMSDAY
|
|---|
| 28 | ..Q
|
|---|
| 29 | MO2E D
|
|---|
| 30 | .I TYCODE="M" Q:'PRCFA("FOB")
|
|---|
| 31 | .S (FMSFOB,FOB)=$G(PRCTMP(442,+PO,6.4,"I"))
|
|---|
| 32 | .I FOB="" S (FMSFOB,FOB)="D"
|
|---|
| 33 | MO2F D
|
|---|
| 34 | .I TYCODE="M" Q:'PRCFA("VEND")
|
|---|
| 35 | .S VEND=$G(PRCTMP(442,+PO,5,"I"))
|
|---|
| 36 | .I VEND]"" D
|
|---|
| 37 | ..N DA S DIC=440,DR=".01;.06;34;35",DA=+VEND,DIQ="PRCTMP(",DIQ(0)="IE" D EN^DIQ1 K DIC,DIQ,DR
|
|---|
| 38 | ..S FMSVENID=$G(PRCTMP(440,VEND,34,"E"))
|
|---|
| 39 | ..S FMSVENCD=$G(PRCTMP(440,VEND,35,"E"))
|
|---|
| 40 | ..S FMSVENNM=$G(PRCTMP(440,VEND,.01,"E"))
|
|---|
| 41 | ..S FMSVENNM=$E(FMSVENNM,1,30)
|
|---|
| 42 | ..I FMSVENID="" D
|
|---|
| 43 | ...S FMSFED=$G(PRCTMP(440,VEND,.06,"I"))
|
|---|
| 44 | ...S FMSVENID=$S(FMSFED:"MISCG",'FMSFED:"MISCN")
|
|---|
| 45 | .I VEND="" I TRCODE="SO" S FMSVENID="MISCN",(FMSVENCD,FMSVENNM)=""
|
|---|
| 46 | MO2G S SEG="MO2^"_FMSPODAT
|
|---|
| 47 | N ACCMO,ACCYR,ACCPD
|
|---|
| 48 | S ACCPD=$P($G(PRCFA("ACCPD")),U),ACCMO=$E(ACCPD,1,2),ACCYR=$E(ACCPD,3,4)
|
|---|
| 49 | S $P(SEG,U,5)=ACCMO,$P(SEG,U,6)=ACCYR,$P(SEG,U,10)=TYCODE
|
|---|
| 50 | I FMSVENID]"" S $P(SEG,U,14)=FMSVENID
|
|---|
| 51 | I FMSVENCD]"" S $P(SEG,U,15)=FMSVENCD
|
|---|
| 52 | I (FMSVENID="MISCN")!(FMSVENID="MISCG") I FMSVENNM]"" S $P(SEG,U,16)=FMSVENNM
|
|---|
| 53 | I FMSFOB]"" S $P(SEG,U,24)=FMSFOB
|
|---|
| 54 | S ^TMP($J,"PRCMO",INT,TMPLINE)=SEG_"^~" K PRCTMP
|
|---|
| 55 | Q
|
|---|
| 56 | ;
|
|---|
| 57 | DATE(X,A,B,C) ;
|
|---|
| 58 | S FMSYR=$E(X,2,3),FMSMO=$E(X,4,5),FMSDAY=$E(X,6,7)
|
|---|
| 59 | Q
|
|---|
| 60 | DATE1(X) ;
|
|---|
| 61 | Q $E(X,4,5)_$E(X,6,7)_$E(X,2,3)
|
|---|
| 62 | Q
|
|---|
| 63 | ASKDATE(X) ;
|
|---|
| 64 | N Y,ASKDATE
|
|---|
| 65 | S %DT="AEX",%DT("A")=X D ^%DT
|
|---|
| 66 | S ASKDATE=Y K %DT
|
|---|
| 67 | Q ASKDATE
|
|---|
