source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENY2K1.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: 3.8 KB
Line 
1ENY2K1 ;;(WIRMFO)/DH-Equipment Y2K Data Acq ;1.15.99
2 ;;7.0;ENGINEERING;**51,55,61**;August 17, 1993
3DATA ; ask user for Y2K fields
4 ; loc var ESCAPE set to 1 for escape from procedure, otherwise undef
5 N DA,J
6 F J="CODE","DATE","COST","TECHI","TECHE","SHOPI","SHOPE","ACT","SOURCE","NOTE","CLASS","UTIL","REPDT" S ENY2K(J)=""
7 S DIR(0)="6914,71",DIR("A")="Please select the Y2K CATEGORY",DIR("B")="CC"
8 D ^DIR K DIR I $D(DIRUT) S ESCAPE=1 Q
9 S ENY2K("CODE")=$P(Y,U)
10 S DIR(0)="6914,71.5",DIR("B")="LOCAL ASSESSMENT"
11 D ^DIR K DIR I $D(DIRUT) S ESCAPE=1 Q
12 S ENY2K("SOURCE")=$P(Y,U)
13 S DIR(0)="6914,81",DIR("B")="Medical device"
14 D ^DIR K DIR I $D(DIRUT) S ESCAPE=1 Q
15 S ENY2K("CLASS")=$P(Y,U)
16 I ENY2K("CLASS")="FS" D Q:$G(ESCAPE)
17 . S DIR(0)="6914,82O"
18 . D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S ESCAPE=1 Q
19 . S ENY2K("UTIL")=$P(Y,U)
20 I ENY2K("CODE")="CC" D Q
21 . S DIR(0)="6914,72",DIR("A")="Enter ESTIMATED Y2K COMPLIANCE DATE"
22 . D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S ESCAPE=1 Q
23 . S ENY2K("DATE")=Y
24 . S DIR(0)="6914,73",DIR("A")="Enter ESTIMATED Y2K COMPLIANCE COST"
25 . D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S ESCAPE=1 Q
26 . S ENY2K("COST")=Y
27 . S DIR(0)="6914,75",DIR("A")="Technician responsible for Y2K upgrade"
28 . D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S ESCAPE=1 Q
29 . S ENY2K("TECHI")=+Y,ENY2K("TECHE")=$P(Y,U,2)
30 . S DIC="^DIC(6922,",DIC(0)="AEQM",DIC("A")="Engineering Section responsible for Y2K upgrade: "
31 . I $G(ENY2K("TECHI"))>0,$P(^ENG("EMP",ENY2K("TECHI"),0),U,10)>0 S DIC("B")=$$GET1^DIQ(6929,ENY2K("TECHI"),.3)
32 . D ^DIC K DIC I $D(DTOUT)!($D(DUOUT)) S ESCAPE=1 Q
33 . S ENY2K("SHOPI")=+Y,ENY2K("SHOPE")=$P(Y,U,2)
34 . S DIR(0)="6914,80",DIR("A")="Notation to appear on Y2K worklist (80 char max)"
35 . D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S ESCAPE=1 Q
36 . S ENY2K("NOTE")=$P(Y,U)
37 I ENY2K("CODE")="NC" D Q
38 . S DIR(0)="6914,76",DIR("A")="Enter the planned Y2K ACTION"
39 . S DIR("?")="What do you plan to do with these non-compliant devices?"
40 . D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S ESCAPE=1 Q
41 . S ENY2K("ACT")=$P(Y,U)
42 . I ENY2K("ACT")="REP" D Q:$G(ESCAPE)
43 .. S DIR(0)="6914,76.1O"
44 .. D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S ESCAPE=1 Q
45 .. S ENY2K("REPDT")=$P(Y,U)
46 . S DIR(0)="6914,80",DIR("A")="Notation to be appended to equipment COMMENTS (80 char max)"
47 . D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S ESCAPE=1 Q
48 . S ENY2K("NOTE")=Y
49 Q ; return control to ENY2K
50 ;
51UPDATE ; update Y2K fields of conditionally compliant and non-compliant
52 ; equipment record(s)
53 S DIE="^ENG(6914,",DR="71///^S X=ENY2K(""CODE"");71.5///^S X=ENY2K(""SOURCE"");81///^S X=ENY2K(""CLASS"")"
54 I ENY2K("CLASS")="FS",$G(ENY2K("UTIL")) S DR=DR_";82///^S X=ENY2K(""UTIL"")"
55 I ENY2K("CODE")="CC" D
56 . I $G(ENY2K("DATE"))?7N S DR=DR_";72///^S X=ENY2K(""DATE"")"
57 . I $G(ENY2K("COST")) S DR=DR_";73///^S X=ENY2K(""COST"")"
58 . I $G(ENY2K("TECHI"))>0 S DR=DR_";75////"_ENY2K("TECHI")
59 . E S DR=DR_";75///^S X=""@"""
60 . I $G(ENY2K("SHOPI"))>0 S DR=DR_";77////"_ENY2K("SHOPI")
61 . E S DR=DR_";77///^S X=""@"""
62 . I $G(ENY2K("NOTE"))]"" S DR=DR_";80///^S X=ENY2K(""NOTE"")"
63 I ENY2K("CODE")="NC" D
64 . I $G(ENY2K("ACT"))]"" S DR=DR_";76///^S X=ENY2K(""ACT"")"
65 . I $G(ENY2K("ACT"))="REP",$G(ENY2K("REPDT")) S DR=DR_";76.1///^S X=ENY2K(""REPDT"")"
66 . I $G(ENY2K("NOTE"))]"" S DR=DR_";80///^S X=ENY2K(""NOTE"")"
67 I ENY2K("CODE")="NA" D
68 . S DR=DR_";72///^S X=""@"";73///^S X=""@"";74///^S X=""@"";75///^S X=""@"";76///^S X=""@"";77///^S X=""@"""
69 S (DA,COUNT)=0 F S DA=$O(^TMP($J,DA)) Q:'DA D
70 . L +^ENG(6914,DA):10 I '$T W !,"Equipment Entry #"_DA_" is being edited by another user. Try again later." Q
71 . D ^DIE W:'(DA#10) "." S COUNT=COUNT+1
72 . I $G(ENY2K("NOTE"))]"" D
73 .. N ENX
74 .. S ENX(1)=ENY2K("NOTE")_" (Y2K note)"
75 .. D WP^DIE(6914,DA_",",40,"A","ENX") D MSG^DIALOG()
76 . L -^ENG(6914,DA)
77 W !,?10,COUNT_" equipment records were updated."
78 Q
79 ;ENY2K1
Note: See TracBrowser for help on using the repository browser.