source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENBCPM1.m@ 1593

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

initial load of WorldVistAEHR

File size: 5.2 KB
Line 
1ENBCPM1 ;(WASH ISC)/DH-Record Bar Coded PMI ;1/9/2001
2 ;;7.0;ENGINEERING;**10,14,21,32,35,68**;Aug 17, 1993
3DNLD ;Get PM Inspector
4 S ENEMP="",DIC="^ENG(""EMP"",",DIC(0)="AEQMZ",DIC("A")="Select PM Inspector: ",DIC("S")="I $P(^(0),U,7)'=""V""" D ^DIC S:Y>0 ENEMP=$P(Y(0),U,1) K DIC
5 I ENEMP]"",$O(^ENG("EMP","B",ENEMP,+Y))]"" S ENEMP=+Y
6 I ENEMP]"" S ENEMP=""""_ENEMP_"""" D ^ENCTBAR
7 Q
8RES ;Restart an aborted process
9 S X="",ENY=0 W !!,"Enter PROCESS ID: " R X:DTIME G:X="^"!(X="") EXIT S ENCTID=$O(^PRCT(446.4,"C",X,"")) I ENCTID="" W !!,*7,"Wrong application. Aborting..." D HOLD G EXIT
10 S X="" W !!,"Enter TIME STAMP of process to be restarted: " R X:DTIME G:X="^"!(X="") EXIT S ENCTTI=$O(^PRCT(446.4,ENCTID,2,"B",X,"")) I ENCTTI="" W !!,"NO DATA. Aborting..." D HOLD G EXIT
11EN ;Main entry point. Expects ENCTID and ENCTTI.
12 ;Normally called by ENCTBAR.
13 G:'$D(ENCTID) ERR^ENBCPM5
14 S ENCTTI(0)=$P(^PRCT(446.4,ENCTID,2,ENCTTI,0),U)
15 S ENSTA=$P($G(^DIC(6910,1,0)),U,2),ENSTAL=$L(ENSTA)
16 I ENSTA="" W !!,"Can't seem to find your STATION NUMBER. Please check File 6910.",!,"Your IRM staff may need to assist you.",*7 G ERR^ENBCPM5
17 F I=1,2,3,4,5,6,7,8 S ENSTA(I)="",ENSTAL(I)=0
18 I $G(^DIC(6910,1,3,0))]"" D
19 . S (I,ENX)=0 F S ENX=$O(^DIC(6910,1,3,ENX)) Q:'ENX!(I>8) D
20 .. S I=I+1,ENSTA(I)=$P(^DIC(6910,1,3,ENX,0),U)
21 .. S ENSTAL(I)=$L(ENSTA(I))
22 I '$D(DT) S U="^",%DT="",X="T" D ^%DT S DT=+Y S:'$D(DTIME) DTIME=600
23 S Y=DT X ^DD("DD") S ENDATE=Y
24 W !! S Y=$E(DT,1,5)_"00" X ^DD("DD") S %DT("A")="For which month do you wish to record PMI's: ",%DT("B")=Y,%DT="AEPMX" D ^%DT G:Y'>0 ERR^ENBCPM5 S ENPMDT=$E(Y,2,5),ENPM="M"
25MORW W !,"Are you recording a MONTHLY (as opposed to a WEEKLY) worklist" S %=1 D YN^DICN G:%<0 ERR^ENBCPM5 G:%=0 MORW I %=1 G EN1
26WEEK R !,"Week number (enter an integer from 1 to 5): ",X:DTIME G:X="^" ERR^ENBCPM5 I X?1N,X>0,X<6 S ENPM="W"_X G EN1
27 W "??",*7 G WEEK
28EN1 S DIC="^DIC(6922,",DIC(0)="AEMQ" D ^DIC G:Y'>0 ERR^ENBCPM5 S ENSHKEY=+Y,ENSHOP=$P(^DIC(6922,ENSHKEY,0),U,1),ENSHABR=$P(^(0),U,2)
29 S ENPMWO="PM-"_ENSHABR_ENPMDT_ENPM
30EN2 S ENDEL="" I $D(^DIC(6910,1,0)) S ENDEL=$P(^(0),U,5)
31 I ENDEL="" R !,"Should existing PM work orders be deleted after close out? YES// ",X:DTIME G:X="^" ERR^ENBCPM5 S:X=""!("Yy"[$E(X)) ENDEL="Y"
32 I ENDEL="","Nn"'[$E(X) D COBH1^ENEQPMR4 G EN2
33CONT ;Physical processing of uploaded data
34 N PMTOT
35 S (ENY,ENPG)=0,ENX=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,0)) I ENX'>0 D HDR^ENBCPM2 W *7,!!,"No data to process." D:$E(IOST,1,2)="C-" HOLD G EXIT
36 S ENX=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)) ;ignore file ID
37 S ENTEC="",ENEMP=^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0),ENX=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)) I ENEMP?.N S ENTEC=ENEMP S ENEMP=$P($G(^ENG("EMP",ENTEC,0)),U)
38 S DIR(0)="P^6929:AEQM^I Y>0,$P(^ENG(""EMP"",+Y,0),U,7)=""V"" K X D EN^DDIOL(""VACATED positions may not be selected."")"
39 S DIR("A",1)="This bar code PMI program was downloaded for "_ENEMP_"."
40 S DIR("A")="Who actually did the work? ",DIR("B")=ENEMP
41 S DIR("?",1)="If "_ENEMP_" performed the PMI, just press <RETURN>."
42 S DIR("?",2)="If you choose another technician, that individual will become the technician"
43 S DIR("?",3)="of record in both the Work Order and Equipment Files."
44 S DIR("?",4)=" "
45 S DIR("?",5)="If more than one technician worked on a PMI then you should either close that"
46 S DIR("?",6)="PM work order individually (before continuing with this update) or perhaps"
47 S DIR("?",7)="use teams in your PMI program. If you want to abort this update and come back"
48 S DIR("?",8)="to it after closing selected work orders manually (via the 'Close Out PM Work"
49 S DIR("?",9)="Order' option), press the caret key ('^') and be sure to write down the"
50 S DIR("?")="'Process ID' and 'Time stamp' that the system will give you."
51 D ^DIR K DIR G:Y'>0!($D(DIRUT)) ERR^ENBCPM5
52 S ENTEC=+Y,ENEMP=$P(Y,U,2)
53 ;
54DEV D MSG^ENBCPM6
55 S %ZIS="Q",%ZIS("A")="Select Device for PMI Exception Messages: " D ^%ZIS K %ZIS G:POP ERR^ENBCPM5
56 G:$D(IO("Q")) ZTSK^ENBCPM2
57 ;
58NEWLOC ;Beginning of a specific location
59 S ENLBL=^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0),ENLOC=$E(ENLBL,3,50) I $E(ENLBL,1,2)'="SP" S ENMSG="LOCATION EXPECTED." D XCPTN^ENBCPM2 S ENX=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)) G:ENX'>0 EXIT G NEWLOC
60 I ENLOC[" " S ENLOC=$P(ENLOC," ")
61 S X=$L(ENLOC) I $E(ENLOC,X)=" " S ENLOC=$E(ENLOC,1,(X-1))
62NEWNX ;Process a piece of equipment
63 S (ENTIME,ENMATRL)=""
64 S ENX=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)) G:ENX'>0 DONE S (ENEQ,ENLBL)=^(ENX,0) G:$E(ENLBL)="*" NEWNX
65 I $E(ENEQ,1,2)="SP" K ENEQ G NEWLOC
66 S ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)="*"_ENEQ
67 I $E(ENEQ,1,4)="MOD:" D NOLBL^ENBCPM3 G NEWNX
68 I $E(ENEQ,1,4)="PM#:" D PMN^ENBCPM3 G NEWNX
69 I $E(ENEQ,3,8)[" EE",$P(ENEQ," ")'=ENSTA D I $D(ENMSG) D XCPTN^ENBCPM2 G NEWNX
70 . K ENMSG S ENMSG="FOREIGN EQUIPMENT."
71 . F I=1:1:8 I ENSTAL(I),$E(ENEQ,1,ENSTAL(I))=ENSTA(I) K ENMSG Q
72 . I $D(ENMSG) S ENMSG(0,1)="Cannot process a bar code label from another VAMC."
73 S ENEQ=$S($D(^ENG(6914,"OEE",ENLBL)):$O(^(ENLBL,0)),1:+$P(ENLBL,"EE",2))
74 I ENEQ>0 D UPDATE^ENBCPM2,POST^ENBCPM4
75 G NEWNX
76 ;
77HOLD I $E(IOST,1,2)="C-" W !,"Press RETURN to continue..." R X:DTIME
78 Q
79DONE ;Delete DATE/TIME OF DATA UPLOAD
80 ;K DA,DIK S DIK="^PRCT(446.4,"_ENCTID_",2,",DA(1)=ENCTID,DA=ENCTTI
81 ;D ^DIK
82 ;K DIK
83EXIT D:$D(PMTOT) ^ENBCPM8 G EXIT^ENBCPM5
84 ;ENBCPM1
Note: See TracBrowser for help on using the repository browser.