source: WorldVistAEHR/trunk/r/IFCAP-PRC-PRX--PRCA--PRCN/PRCUFCF.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

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