source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENBCPM3.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: 2.6 KB
Line 
1ENBCPM3 ;(WASH ISC)/DH-Bar Coded PMI ;3.4.97
2 ;;7.0;ENGINEERING;**21,35**;Aug 17, 1993
3NOLBL ;No bar code label scanned
4 N ENDA,EN,ENSN,ENMOD
5 F I=0,1,2 S EN(I)=""
6 S ENLBL="NO LABEL",EN(0)=$E(ENEQ,5,40),ENX1=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)) I ENX1]"" S EN(1)=$S($E(^(ENX1,0))="*":"",1:^(0)) S:$E(EN(1),1,4)="S/N:" ^(0)="*"_EN(1),ENX=ENX1,EN(1)=$E(EN(1),5,40)
7 S EN(2)="NO DESCRIPTION.",ENX1=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)) S ENLKAHD=$S(ENX1]"":^(ENX1,0),1:"")
8 I ENLKAHD]"",$E(ENLKAHD)'="*",$E(ENLKAHD,1,2)'="SP",$E(ENLKAHD,1,4)'="MOD:",$E(ENLKAHD,1,4)'="PM#:",ENLKAHD'[" EE" S EN(2)=ENLKAHD,ENX=ENX1,^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)="*"_ENLKAHD
9 I EN(0)[" " D
10 . F Q:$E(EN(0))'=" " S EN(0)=$E(EN(0),2,99)
11 . F Q:$E(EN(0),$L(EN(0)))'=" " S EN(0)=$E(EN(0),1,($L(EN(0))-1))
12 I EN(1)[" " D
13 . F Q:$E(EN(0))'=" " S EN(0)=$E(EN(0),2,99)
14 . F Q:$E(EN(0),$L(EN(0)))'=" " S EN(0)=$E(EN(0),1,($L(EN(0))-1))
15 I EN(1)]"" D
16 . S ENDA=$O(^ENG(6914,"F",EN(1),0)) I ENDA>0 S ENSN=EN(1) Q
17 . S EN(1,0)=$TR(EN(1)," ~!@#$%^&*()_+|`-=\[]{};':"",./<>?",""),EN(1,0)=$$UP^XLFSTR(EN(1,0)) S ENDA=$O(^ENG(6914,"FC",(EN(1,0)_" "),0)) I ENDA>0 S ENSN=$P($G(^ENG(6914,ENDA,1)),U,3)
18 I $G(ENSN)]"" D Q
19 . I EN(0)'=$P($G(^ENG(6914,ENDA,1)),U,2) S ENMSG(0,2)="NOTE: Entered MODEL ("_EN(0)_") does not match stored value."
20 . S ENEQ=ENDA D MATCH,POST^ENBCPM4
21 ;If match found EN will be killed
22 I $D(EN) S ENMSG="ITEM NOT IN DATABASE.",ENMSG(0,1)="Model: "_EN(0),ENMSG(0,2)="Serial number: "_EN(1),ENMSG(0,3)="Description: "_EN(2) D TKNOTE,XCPTN^ENBCPM2
23 Q
24 ;
25PMN ;Process PM #
26 S ENLBL="NO LABEL",^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)="*"_ENEQ,ENEQ=$E(ENEQ,5,40) S:ENEQ[" " ENEQ=$TR(ENEQ," ") S ENDA=$O(^ENG(6914,"C",ENEQ,0)) I ENDA>0 S ENEQ=ENDA D MATCH,POST^ENBCPM4 Q
27 S ENMSG="ITEM NOT IN DATABASE.",ENMSG(0,1)="PM #: "_ENEQ
28 D TKNOTE,XCPTN^ENBCPM2
29 Q
30 ;
31MATCH ; Equipment unlabelled but present in 6914
32 S ENMSG="BAR CODE LABEL MISSING. Equipment ID#: "_ENEQ,ENMSG(0,1)="Record will be updated, but bar code label should be printed and applied."
33 D XCPTN^ENBCPM2
34 D UPDATE^ENBCPM2
35 K EN Q
36 ;
37TKNOTE ;Addtn'l info to Excptn Mess
38 S ENX1=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)) S ENLKAHD=$S(ENX1]"":^(ENX1,0),1:"") G:ENLKAHD="" TKNOTE2
39 I $E(ENLKAHD)'="*",$E(ENLKAHD,1,2)'="SP",$E(ENLKAHD,1,4)'="MOD:",$E(ENLKAHD,1,4)'="PM#:",ENLKAHD'[" EE" D TKNOTE1 S ENX=ENX1,^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)="*"_ENLKAHD G TKNOTE
40 G TKNOTE2
41 ;
42TKNOTE1 F J=0:0 S J=$O(ENMSG(0,J)) Q:J'>0 S I=J
43 S I=I+1,ENMSG(0,I)=ENLKAHD
44 Q
45 ;
46TKNOTE2 ;Exit subrtn
47 Q
48 ;
49HOLD I $E(IOST,1,2)="C-" W !,"Press RETURN to continue..." R X:DTIME
50 Q
51 ;ENBCPM3
Note: See TracBrowser for help on using the repository browser.