source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENSA1.m@ 701

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

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1ENSA1 ;(WASH ISC)/DH-MedTester Interface ;12/21/2000
2 ;;7.0;ENGINEERING;**9,14,21,45,48,54,67**;Aug 17, 1993
3UPLD ;Read from ESU
4 K ^ENG("TMP",ENTID)
5 W !!,"Enter the device to which the MedTester is connected.",! D ^%ZIS Q:POP
6 S ENCTEON=^%ZOSF("EON"),ENCTEOFF=^%ZOSF("EOFF"),ENCTTYPE=^%ZOSF("TYPE-AHEAD"),ENCTOPEN=$G(^%ZIS(2,IOST(0),10)),ENCTCLOS=$G(^%ZIS(2,IOST(0),11))
7 U IO D OFF W !,"...OK, use the MedTester 'PALL' function to send the data. Please",!,"be sure that you are connected to a MedTester COMM port and that the",!,"MedTester PRINTER port is OFF."
8 D ON R X:60 I '$T D OFF W !!,"Data transmission failure.",*7 D HOLD G EXIT
9 S X=$TR(X,$C(0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31)) ;strip control chars
10 ; next 4 lines will cause routine to ignore blank lines (Open-M) problem
11 F Q:$E(X)'=" " S X=$E(X,2,245)
12 S I=0 I X]"" S I=I+1,^ENG("TMP",ENTID,I)=X
13 F R X:10 Q:'$T I X]"" S X=$TR(X,$C(10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27)) D I X]"" S I=I+1,^ENG("TMP",ENTID,I)=X D:'(I#5) MARK
14 . F Q:$E(X)'=" " S X=$E(X,2,245)
15 R %:1 ;clear buffer
16 D OFF
17 D ^%ZISC
18 Q ;Data upload finished
19 ;
20MARK I IO=IO(0) D OFF
21 U IO(0) W "." U IO
22 I IO=IO(0) D ON
23 Q
24 ;
25ON X ENCTOPEN U IO X ENCTEOFF,ENCTTYPE
26 Q
27 ;
28OFF X ENCTCLOS,ENCTEON U IO(0)
29 Q
30 ;
31PROCS ;Process test results
32 K ^TMP($J)
33 N PMTOT S ENBRANCH="RECNUM^DATE^OPCODE^DEVICE^COMNTS^OTHER"
34 S (ENREC,ENEQ,ENLOC,ENEMP,ENTEC,ENSTDT,ENSN,ENMOD,ENWP,ENTIME,ENTEST)="",(ENFAIL,ENFLG,ENPG,ENY)=0 K ENLBL
35READ S ENSA1=0 F S ENSA1=$O(^ENG("TMP",ENTID,ENSA1)) Q:'ENSA1 D MEDCHK
36 I $D(ENLBL) D UPDT
37 I $D(PMTOT) D ^ENBCPM8
38 Q ;Return control to ENSA
39 ;
40MEDCHK S X=^ENG("TMP",ENTID,ENSA1) F Q:$E(X)'=$C(32) S X=$E(X,2,245)
41 I X["MedTester" S X="MedTester REC #"_$P(X," REC #",2)
42 S ENX=X,X1=$S($E(X,1,9)="MedTester":1,$E(X,1,9)="SEQUENCE:":2,$E(X,1,14)="OPERATOR CODE:":3,$E(X,1,8)="OP CODE:":3,$E(X,1,18)="DEVICE INFORMATION":4,$E(X,1,9)="COMMENTS:":5,1:6)
43 D @($P(ENBRANCH,U,X1))
44 Q
45 ;
46RECNUM D:$D(ENLBL) UPDT K ENLBL ; post data (if any) from last test
47 ; init variables for this test
48 K ENSN,ENMOD,ENPMN,ENSTDT,ENPMWO(0)
49 S (ENEQ,ENLOC,ENEMP,ENTEC,ENSTDT,ENSN,ENMOD,ENWP,ENTIME,ENTEST)="",(ENFAIL,ENFLG)=0
50 S X=$TR($P(ENX,"REC #",2),$C(32))
51 S ENREC=X D:ENPAPER LNPRNT^ENSA7
52 Q
53DATE ;Date of ESA
54 N DELYR ; for Y2K
55 S X=^ENG("TMP",ENTID,ENSA1),X=$P(X,"DATE:",2),X1=$P(X,"TIME:",1)
56 S X1=$TR(X1,$C(10,32))
57 S XM=$P(X1,"/",1),XD=$P(X1,"/",2),XY=$P(X1,"/",3)
58 S:$L(XM)<2 XM="0"_XM
59 S:$L(XD)<2 XD="0"_XD
60 S:$L(XY)<2 XY="0"_XY ; added by *67 for non-y2k compliant Medtesters
61 S DELYR=$E(DT,2,3)-XY
62 S ENSTDT=$E(DT)+$S(DELYR>79:1,DELYR<-20:-1,1:0)_XY_XM_XD
63 I ENSTDT'?7N S ENSTDT="" ; result was an invalid date format
64 K XM,XD,XY
65 I ENPAPER D LNPRNT^ENSA7
66 Q
67OPCODE ;Operator
68 S (ENTEC,ENEMP)="",X=$TR($P(X,":",2),$C(32))
69 I X]"" D
70 . I X=+X S ENTEC=X,ENEMP=$S($D(^ENG("EMP",X,0)):$P(^(0),U),1:"") Q
71 . I $D(^ENG("EMP","B",X)) S ENEMP=X,ENTEC=$O(^(X,0)) Q
72 . S X(1)=$L(X),X(2)=$O(^ENG("EMP","B",X)) I $E(X(2),1,X(1))=X D
73 .. I $E($O(^ENG("EMP","B",X(2))),1,X(1))=X Q
74 .. S ENTEC=$O(^ENG("EMP","B",X(2),0)),ENEMP=$P(^ENG("EMP",ENTEC,0),U)
75 D:ENPAPER LNPRNT^ENSA7
76 Q
77DEVICE ;Equipment id
78 F J=1,2 S ENSA1=$O(^ENG("TMP",ENTID,ENSA1)),X(J)=^ENG("TMP",ENTID,ENSA1)
79 S X(3)="",X=$G(^ENG("TMP",ENTID,ENSA1+1)) F Q:$E(X)'=" " S X=$E(X,2,30)
80 I $E(X,1,7)="CONTROL" D ; accomodate MedTester 5000C
81 . S ENSA1=ENSA1+1,X(3)=$TR($P(X,":",2),$C(10)) F Q:$E(X(3))'=" " S X(3)=$E(X(3),2,50)
82 . S I=$L(X(3)) F Q:$E(X(3),I)'=" "!(I<1) S I=I-1,X(3)=$E(X(3),1,I)
83 S X=$P(X(1),"LOC:",2) F J=0:0 Q:$E(X)'=" " S X=$E(X,2,30)
84 S ENLOC=X I $E(ENLOC,1,2)="SP" S ENLOC=$E(ENLOC,3,30)
85 I ENLOC[" " S ENLOC=$P(ENLOC," ")
86 S X=$L(ENLOC) I $E(ENLOC,X)=" " S ENLOC=$E(ENLOC,1,(X-1))
87 S X=$P(X(2),":",2)
88 S X=$S($E(X,$L(X)-1,$L(X))="SN":$E(X,1,$L(X)-2),$E(X,$L(X)-7,$L(X))="SERIAL #":$E(X,1,$L(X)-8),1:X)
89 S X=$TR(X,$C(32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47))
90 S ENMOD(0)=$E(X,1,16)
91 S X=$P(X(2),":",3)
92 S X=$S($E(X,$L(X)-1,$L(X))="CN":$E(X,1,$L(X)-2),$E(X,$L(X)-8,$L(X))="CONTROL #":$E(X,1,$L(X)-9),1:X)
93 S X=$TR(X,$C(10,32))
94 S ENSN(0)=$E(X,1,16)
95 I X(3)]"" S X=X(3)
96 E D
97 . S X=$TR($P(X(2),":",4),$C(10)) F Q:$E(X)'=" " S X=$E(X,2,30)
98 . S I=$L(X) F Q:$E(X,I)'=" "!(I<1) S I=I-1,X=$E(X,1,I)
99 S ENLBL=X,ENEQ="" D DEVICE^ENSA7
100 K X Q
101COMNTS ;MedTester comments
102 S X=$TR($E(X,11,128),$C(10))
103 S ENWP=X_" MedTester" S:$E(X)="#" ENFAIL=1
104 I ENPAPER D LNPRNT^ENSA7
105 Q
106OTHER ;All other, mainly specific test results
107 I $E(X,1,10)="USER TIME:" S ENTIME=+$TR($P(X,":",2)," ")
108 ;
109 ; distinguish between EKG and DEFIB tests and hope that we're not
110 ; missing other flavors of MedTester procedures
111 ;
112 ; if line has text indicating start of a test results section then
113 ; set ENFLG = 1 (true) so subsequent lines will be checked for
114 ; presence of '#' which indicates a test failure
115 ;
116 I $E(X,1,12)="LINE VOLTAGE" S ENFLG=1,ENTEST="EKG" ; for esa test
117 I $E(X,1,5)="DEFIB" S ENFLG=1,ENTEST="DEFIB" ; for defib test
118 ;
119 ; if line has text indicating section after test results then
120 ; set ENFLG = 0 (false) so subsequent lines will not be checked for
121 ; presence of '#'
122 ;
123 I $E(X,1,11)="PERFORMANCE" S ENFLG=0 ; for any test
124 ;
125 ; if ENFLG true then check for failure unless line starts STEP#
126 ; since defib tests use 'STEP #' as a column header
127 ;
128 I ENFLG,$E(X,1,4)'="STEP",X["#" S ENFAIL=1
129 ;
130 I ENPAPER D LNPRNT^ENSA7
131 Q
132 ;
133UPDT ;Update Equipment File
134 S ENEQ(0)=1 I ENEQ]"" D UPDATE^ENSA2 D:$D(^ENG(6914,ENEQ,0)) POST^ENSA4
135 I ENEQ(0),ENLBL?4N1"-"4N0.1A D PMN^ENSA2 I ENEQ]"",$D(^ENG(6914,ENEQ,0)) D POST^ENSA4
136 I ENEQ(0) D NOLBL^ENSA3
137 I $D(ENXP("?")) D DEVCK3^ENSA7 K ENXP("?")
138 Q
139 ;
140HOLD W !,"Press <RETURN> to continue..." R X:DTIME
141 Q
142EXIT G EXIT^ENSA3
143 ;ENSA1
Note: See TracBrowser for help on using the repository browser.