source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENEXPT.m@ 699

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

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1ENEXPT ;WISC/DH,SAB-Engineering Equipment Export ;1/18/96
2 ;;7.0;ENGINEERING;**20,27**;Aug 17, 1993
3MAIN ;
4 S ENSND=$P($G(^DIC(6910,1,0)),U,2),ENST=$E(1000+$E(ENSND,1,3),2,4)
5 I 'ENST W !,"Please enter Station Number (field 1) in the Eng Init Paramters File (6910)." Q
6 ;
7 D ASK^ENEXPT1 D ^DIR K DIR G:$D(DIRUT) KILL I Y D EN^ENEXPT1
8 W ! S DIR(0)="Y",DIR("A")="Should equipment data be transmitted to NESC"
9 D ^DIR K DIR G:$D(DIRUT)!'Y KILL
10 ;
11QUE ;
12 S %DT="AEFRSX",%DT("B")="NOW",%DT(0)="NOW"
13 S %DT("A")="Enter a future date and time to queue this export: "
14 D ^%DT
15 I Y<1!$D(DTOUT) G KILL
16 S ZTRTN="IN^ENEXPT",ZTIO="",ZTDTH=Y
17 S ZTSAVE("ENSND")="",ZTSAVE("ENST")="",ZTSAVE("DUZ")=""
18 S ZTDESC="Equipment Export Transmission",ZTSAVE("ZTREQ")="@"
19 D ^%ZTLOAD
20 W !,$S($D(ZTSK):"Task "_ZTSK_" queued.",1:"Job Cancelled")
21KILL ;
22 K ZTSK,ZTSAVE,ZTRTN,ZTIO,ZTDESC,ZTDTH,ENSND,ENST,%DT,DIRUT,DTOUT,X,Y
23 Q
24IN ;
25 K ^TMP($J)
26 D COUNT
27 S ENDA=0,ENMSG=0,ENITEM=0
28 D HEADER
29 F S ENDA=$O(^TMP($J,2,ENDA)) Q:ENDA'>0 D
30 .S ENOD0=$G(^ENG(6914,ENDA,0)) Q:ENOD0=""
31 .S ENITEM=ENITEM+1
32 .S ENOD1=$G(^ENG(6914,ENDA,1))
33 .S ENOD2=$G(^ENG(6914,ENDA,2))
34 .S ENOD3=$G(^ENG(6914,ENDA,3))
35 .S ENOD7=$G(^ENG(6914,ENDA,7))
36 .S ENOD8=$G(^ENG(6914,ENDA,8))
37 .D PACK
38 .I (ENITEM#90=0) D SEND,HEADER
39 D:(ENITEM#90'=0) SEND
40 Q
41EXIT ;
42 K ^TMP($J),XMDUZ,XMY,XMSUB,XMTEXT,XMZ
43 K ENDA,ENOD0,ENOD1,ENOD2,ENOD3,ENOD7,ENOD8,ENHEAD,ENTIME,ENDATE,ENL
44 K ENSA,ENSB,ENSC,ENSD,ENSE,ENSF,ENITEM,ENMXSEQ,ENMSG,ENST,ENITEM,%DT
45 K ENLCPT,ENLOC,ENFNCTPT,ENHO89PT,ENFNCT,ENH089,ENSN,ENSND
46 Q
47COUNT ;
48 S ENDA=0,ENITEM=0
49 F S ENDA=$O(^ENG(6914,ENDA)) Q:ENDA'>0 D
50 .S ENOD0=$G(^ENG(6914,ENDA,0)),ENOD3=$G(^ENG(6914,ENDA,3))
51 .I $P(ENOD0,U,4)="NX",("^4^5^"'[(U_$P(ENOD3,U,1)_U)) S ENITEM=ENITEM+1,^TMP($J,2,ENDA)=""
52 S ENMXSEQ=ENITEM+89\90
53 Q
54PACK ;
55 D NODE0
56 D:ENOD1'="" NODE1
57 D:ENOD2'="" NODE2
58 D:ENOD3'="" NODE3
59 D:ENOD7'="" NODE7
60 D:ENOD8'="" NODE8
61 Q
62NODE0 ;
63 S ENL=ENL+1
64 S ENSN=$P($G(^ENG(6914,ENDA,9)),U,5) S:ENSN="" ENSN=ENSND
65 S ENSA="A^"_ENSN_U_$P(ENOD0,U)_U_$P(ENOD0,U,2)_U
66 S ENSA=ENSA_$S($P(ENOD0,U,3)>0:$P($G(^ENG(6914,$P(ENOD0,U,3),0)),U),1:"")_"^|"
67 S ENL=ENL+1,^XMB(3.9,XMZ,2,ENL,0)=ENSA
68 Q
69NODE1 ;
70 S ENSB="B^"
71 S ENSB=ENSB_$S($P(ENOD1,U)>0:$P($G(^ENG(6911,$P(ENOD1,U,1),0)),U),1:"")
72 S ENSB=ENSB_U_$P(ENOD1,U,2)_U
73 S ENSB=ENSB_$S($P(ENOD1,U,4)>0:$P($G(^ENG("MFG",$P(ENOD1,U,4),0)),U),1:"")_"^|"
74 S:ENSB'="B^^^^|" ENL=ENL+1,^XMB(3.9,XMZ,2,ENL,0)=ENSB
75 Q
76NODE2 ;
77 S ENSC="C^"_$P(ENOD2,U,3)_U_$$XFDT($P(ENOD2,U,4),"D")_U
78 S ENSC=ENSC_$$XFDT($P(ENOD2,U,5),"D")_U_$P(ENOD2,U,6)_U_$P(ENOD2,U,7)_U
79 S ENSC=ENSC_$S($P(ENOD2,U,8)>0:$P($G(^ENCSN(6917,$P(ENOD2,U,8),0)),U),1:"")
80 S ENSC=ENSC_U_$S($P(ENOD2,U,9)>0:$E($P($G(^ENG(6914.1,$P(ENOD2,U,9),0)),U),1,5),1:"")
81 S ENSC=ENSC_U_$$XFDT($P(ENOD2,U,10),"D")_U_$P(ENOD2,U,12)_U
82 S ENSC=ENSC_$$XFDT($P(ENOD2,U,13),"D")_"^|"
83 S:ENSC'="C^^^^^^^^^^^|" ENL=ENL+1,^XMB(3.9,XMZ,2,ENL,0)=ENSC
84 Q
85NODE3 ;
86 S ENSD="D^"_$P(ENOD3,U)_U
87 S ENSD=ENSD_$S($P(ENOD3,U,2)>0:$P($G(^DIC(49,$P(ENOD3,U,2),0)),U),1:"")
88 S ENSD=ENSD_U_$P(ENOD3,U,4)_U
89 S ENLCPT=$P(ENOD3,U,5)
90 S ENLOC=$S(ENLCPT>0:$P($G(^ENG("SP",ENLCPT,0)),U),1:"")
91 S ENFNCTPT=$S(ENLCPT>0:$P($G(^ENG("SP",ENLCPT,4)),U),1:"")
92 S ENHO89PT=$S(ENLCPT>0:$P($G(^ENG("SP",ENLCPT,9)),U,2),1:"")
93 S ENFNCT=$S(ENFNCTPT'="":$P($G(^ENG(6928.1,ENFNCTPT,0)),U),1:"")
94 S ENH089=$S(ENHO89PT'="":$P($G(^OFM(7336.6,ENHO89PT,0)),U),1:"")
95 S ENSD=ENSD_ENLOC_U_ENFNCT_U_ENH089_U_$P(ENOD3,U,7)_U_$P(ENOD3,U,9)_"^|"
96 S:ENSD'="D^^^^^^^^^|" ENL=ENL+1,^XMB(3.9,XMZ,2,ENL,0)=ENSD
97 Q
98NODE7 ;
99 S ENSE="E^"_$P(ENOD7,U)_U_$P(ENOD7,U,2)_"^|"
100 S:ENSE'="E^^^|" ENL=ENL+1,^XMB(3.9,XMZ,2,ENL,0)=ENSE
101 Q
102NODE8 ;
103 S ENSF="F^"_$S($P(ENOD8,U)=1:"Y",$P(ENOD8,U)=0:"N",1:"")_U
104 S ENSF=ENSF_$S($P(ENOD8,U,2)=1:"Y",$P(ENOD8,U,2)=0:"N",1:"")_U
105 S ENSF=ENSF_$P(ENOD8,U,8)_U_$P(ENOD8,U,9)_"^|"
106 S:ENSF'="F^^^^^|" ENL=ENL+1,^XMB(3.9,XMZ,2,ENL,0)=ENSF
107 Q
108HEADER ;
109 Q:ENMSG=ENMXSEQ
110 S ENMSG=ENMSG+1,ENL=1
111 S XMDUZ=DUZ,XMSUB="Seq # "_ENMSG_" from Site "_ENST_" Equipment Extract"
112 D XMZ^XMA2
113 I XMZ<1 G EXIT
114 D:'$D(DT) DT^DICRW
115 D NOW^%DTC
116 S ENHEAD="ENG^"_ENST_"^EQUIP^"_$$XFDT(%)_U
117 S ENHEAD=ENHEAD_$$LTZ^ENPLUTL_$E(" ",1,3-$L($$LTZ^ENPLUTL))_U
118 S ENHEAD=ENHEAD_$E(1000+ENMSG,2,4)_U_$E(1000+ENMXSEQ,2,4)_"^002^|"
119 S ^XMB(3.9,XMZ,2,ENL,0)=ENHEAD
120 K %
121 Q
122SEND ;
123 S ENL=ENL+1,^XMB(3.9,XMZ,2,ENL,0)=$S(ENMSG=ENMXSEQ:"$",1:"~")
124 S XMY("G.ACTIVATION EQUIPMENT@NESC.MED.VA.GOV")="",XMY(DUZ)=""
125 S XMY("S.ACTEQUIP@NESC.MED.VA.GOV")=""
126 S ^XMB(3.9,XMZ,2,0)="^3.92A^"_ENL_U_ENL_U_DT
127 D ENT1^XMD
128 K XMDUZ,XMY,XMSUB,XMTEXT
129 Q
130XFDT(ENDTI,ENDONLY) ;Convert FileMan Date/Time to YYYYMMDD^HHMMSS
131 ; ENDTI - FileMan date/time
132 ; ENDONLY - contains "D" to just return date
133 Q:$G(ENDTI)']""&($G(ENDONLY)["D") ""
134 Q:$G(ENDTI)']"" "00000000^000000"
135 Q:$G(ENDONLY)["D" 17000000+ENDTI\1
136 Q 17000000+ENDTI\1_"^"_$P(ENDTI,".",2)_$E("000000",1,6-$L($P(ENDTI,".",2)))
137 ;ENEXPT
Note: See TracBrowser for help on using the repository browser.