PRCUFCF ;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.
 ;
 ; Routine is modification of PRCFFU2 for conversion processing
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^"[("^"_PRCFA("MP")_"^"))) D
 .S (BEGDATE,FMSPODAT,PODATE)=$G(PRCTMP(442,+PO,.1,"I"))
 .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
 ..D NOW^%DTC S (BEGDATE,FMSPODAT,PODATE)=$P(%,".")
 ..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,$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