Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PRCUFCF

PRCUFCF.m

Go to the documentation of this file.
  1. PRCUFCF ;WISC/SJG-FMS MO2 SEGMENT ;11/29/93 09:45
  1. V ;;5.1;IFCAP;;Oct 20, 2000
  1. ;Per VHA Directive 10-93-142, this routine should not be modified.
  1. ;
  1. ; Routine is modification of PRCFFU2 for conversion processing
  1. MO2(NODE,TYCODE) ;BUILD 'MO2' SEGMENT
  1. ; .1 - P.O. DATE FROM 442 .01 - NAME FROM 440
  1. ; 5 - VENDOR FROM 442 .06 - FEDERAL SOURCE FROM 440
  1. ; 6.4 - FOB POINT FROM 442 34 - FMS VENDOR CODE FROM 440
  1. ; 35 - ALT-ADDR-IND FROM 440
  1. MO2A N SEG,FMSYR,FMSMO,FMSDAY,VEND,FMSVENCD,FMSVENNM,FMSPODAT,FMSFOB
  1. S (FMSVENID,FMSVENCD,FMSVENNM,FMSFOB)=""
  1. S TMPLINE=TMPLINE+1
  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
  1. MO2B I (TRCODE="MO")&(("^1^3^4^7^8^"[("^"_PRCFA("MP")_"^"))) D
  1. .S (BEGDATE,FMSPODAT,PODATE)=$G(PRCTMP(442,+PO,.1,"I"))
  1. .D DATE(FMSPODAT,.A,.B,.C) S FMSPODAT=FMSYR_U_FMSMO_U_FMSDAY
  1. MO2C I (TRCODE="SO")&(PRCFA("MP")=2) D
  1. .S (BEGDATE,FMSPODAT,PODATE)=PRCFA("OBLDATE")
  1. .D DATE(FMSPODAT,.A,.B,.C) S FMSPODAT=FMSYR_U_FMSMO_U_FMSDAY
  1. MO2D I (TRCODE="SO")&(PRCFA("MP")=21) D
  1. .I TYCODE="E" D
  1. ..D NOW^%DTC S (BEGDATE,FMSPODAT,PODATE)=$P(%,".")
  1. ..S FMSPODAT=$E(PODATE,2,3)_U_$E(PODATE,4,5)_U_$E(PODATE,6,7)
  1. ..Q
  1. .I TYCODE="M" D
  1. ..S (BEGDATE,FMSPODAT,PODATE)=PRCFA("OBLDATE")
  1. ..D DATE(FMSPODAT,.A,.B,.C) S FMSPODAT=FMSYR_U_FMSMO_U_FMSDAY
  1. ..Q
  1. MO2E D
  1. .I TYCODE="M" Q:'PRCFA("FOB")
  1. .S (FMSFOB,FOB)=$G(PRCTMP(442,+PO,6.4,"I"))
  1. .I FOB="" S (FMSFOB,FOB)="D"
  1. MO2F D
  1. .I TYCODE="M" Q:'PRCFA("VEND")
  1. .S VEND=$G(PRCTMP(442,+PO,5,"I"))
  1. .I VEND]"" D
  1. ..N DA S DIC=440,DR=".01;.06;34;35",DA=+VEND,DIQ="PRCTMP(",DIQ(0)="IE" D EN^DIQ1 K DIC,DIQ,DR
  1. ..S FMSVENID=$G(PRCTMP(440,VEND,34,"E"))
  1. ..S FMSVENCD=$G(PRCTMP(440,VEND,35,"E"))
  1. ..S FMSVENNM=$G(PRCTMP(440,VEND,.01,"E"))
  1. ..S FMSVENNM=$E(FMSVENNM,1,30)
  1. ..I FMSVENID="" D
  1. ...S FMSFED=$G(PRCTMP(440,VEND,.06,"I"))
  1. ...S FMSVENID=$S(FMSFED:"MISCG",'FMSFED:"MISCN")
  1. .I VEND="" I TRCODE="SO" S FMSVENID="MISCN",(FMSVENCD,FMSVENNM)=""
  1. MO2G S SEG="MO2^"_FMSPODAT,$P(SEG,U,10)=TYCODE
  1. I FMSVENID]"" S $P(SEG,U,14)=FMSVENID
  1. I FMSVENCD]"" S $P(SEG,U,15)=FMSVENCD
  1. I (FMSVENID="MISCN")!(FMSVENID="MISCG") I FMSVENNM]"" S $P(SEG,U,16)=FMSVENNM
  1. I FMSFOB]"" S $P(SEG,U,24)=FMSFOB
  1. S ^TMP($J,"PRCMO",INT,TMPLINE)=SEG_"^~" K PRCTMP
  1. Q
  1. ;
  1. DATE(X,A,B,C) ;
  1. S FMSYR=$E(X,2,3),FMSMO=$E(X,4,5),FMSDAY=$E(X,6,7)
  1. Q
  1. DATE1(X) ;
  1. Q $E(X,4,5)_$E(X,6,7)_$E(X,2,3)
  1. Q
  1. ASKDATE(X) ;
  1. N Y,ASKDATE
  1. S %DT="AEX",%DT("A")=X D ^%DT
  1. S ASKDATE=Y K %DT
  1. Q ASKDATE