80 lines
3.8 KiB
Mathematica
80 lines
3.8 KiB
Mathematica
ENY2K1 ;;(WIRMFO)/DH-Equipment Y2K Data Acq ;1.15.99
|
|
;;7.0;ENGINEERING;**51,55,61**;August 17, 1993
|
|
DATA ; ask user for Y2K fields
|
|
; loc var ESCAPE set to 1 for escape from procedure, otherwise undef
|
|
N DA,J
|
|
F J="CODE","DATE","COST","TECHI","TECHE","SHOPI","SHOPE","ACT","SOURCE","NOTE","CLASS","UTIL","REPDT" S ENY2K(J)=""
|
|
S DIR(0)="6914,71",DIR("A")="Please select the Y2K CATEGORY",DIR("B")="CC"
|
|
D ^DIR K DIR I $D(DIRUT) S ESCAPE=1 Q
|
|
S ENY2K("CODE")=$P(Y,U)
|
|
S DIR(0)="6914,71.5",DIR("B")="LOCAL ASSESSMENT"
|
|
D ^DIR K DIR I $D(DIRUT) S ESCAPE=1 Q
|
|
S ENY2K("SOURCE")=$P(Y,U)
|
|
S DIR(0)="6914,81",DIR("B")="Medical device"
|
|
D ^DIR K DIR I $D(DIRUT) S ESCAPE=1 Q
|
|
S ENY2K("CLASS")=$P(Y,U)
|
|
I ENY2K("CLASS")="FS" D Q:$G(ESCAPE)
|
|
. S DIR(0)="6914,82O"
|
|
. D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S ESCAPE=1 Q
|
|
. S ENY2K("UTIL")=$P(Y,U)
|
|
I ENY2K("CODE")="CC" D Q
|
|
. S DIR(0)="6914,72",DIR("A")="Enter ESTIMATED Y2K COMPLIANCE DATE"
|
|
. D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S ESCAPE=1 Q
|
|
. S ENY2K("DATE")=Y
|
|
. S DIR(0)="6914,73",DIR("A")="Enter ESTIMATED Y2K COMPLIANCE COST"
|
|
. D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S ESCAPE=1 Q
|
|
. S ENY2K("COST")=Y
|
|
. S DIR(0)="6914,75",DIR("A")="Technician responsible for Y2K upgrade"
|
|
. D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S ESCAPE=1 Q
|
|
. S ENY2K("TECHI")=+Y,ENY2K("TECHE")=$P(Y,U,2)
|
|
. S DIC="^DIC(6922,",DIC(0)="AEQM",DIC("A")="Engineering Section responsible for Y2K upgrade: "
|
|
. I $G(ENY2K("TECHI"))>0,$P(^ENG("EMP",ENY2K("TECHI"),0),U,10)>0 S DIC("B")=$$GET1^DIQ(6929,ENY2K("TECHI"),.3)
|
|
. D ^DIC K DIC I $D(DTOUT)!($D(DUOUT)) S ESCAPE=1 Q
|
|
. S ENY2K("SHOPI")=+Y,ENY2K("SHOPE")=$P(Y,U,2)
|
|
. S DIR(0)="6914,80",DIR("A")="Notation to appear on Y2K worklist (80 char max)"
|
|
. D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S ESCAPE=1 Q
|
|
. S ENY2K("NOTE")=$P(Y,U)
|
|
I ENY2K("CODE")="NC" D Q
|
|
. S DIR(0)="6914,76",DIR("A")="Enter the planned Y2K ACTION"
|
|
. S DIR("?")="What do you plan to do with these non-compliant devices?"
|
|
. D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S ESCAPE=1 Q
|
|
. S ENY2K("ACT")=$P(Y,U)
|
|
. I ENY2K("ACT")="REP" D Q:$G(ESCAPE)
|
|
.. S DIR(0)="6914,76.1O"
|
|
.. D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S ESCAPE=1 Q
|
|
.. S ENY2K("REPDT")=$P(Y,U)
|
|
. S DIR(0)="6914,80",DIR("A")="Notation to be appended to equipment COMMENTS (80 char max)"
|
|
. D ^DIR K DIR I $D(DTOUT)!($D(DUOUT)) S ESCAPE=1 Q
|
|
. S ENY2K("NOTE")=Y
|
|
Q ; return control to ENY2K
|
|
;
|
|
UPDATE ; update Y2K fields of conditionally compliant and non-compliant
|
|
; equipment record(s)
|
|
S DIE="^ENG(6914,",DR="71///^S X=ENY2K(""CODE"");71.5///^S X=ENY2K(""SOURCE"");81///^S X=ENY2K(""CLASS"")"
|
|
I ENY2K("CLASS")="FS",$G(ENY2K("UTIL")) S DR=DR_";82///^S X=ENY2K(""UTIL"")"
|
|
I ENY2K("CODE")="CC" D
|
|
. I $G(ENY2K("DATE"))?7N S DR=DR_";72///^S X=ENY2K(""DATE"")"
|
|
. I $G(ENY2K("COST")) S DR=DR_";73///^S X=ENY2K(""COST"")"
|
|
. I $G(ENY2K("TECHI"))>0 S DR=DR_";75////"_ENY2K("TECHI")
|
|
. E S DR=DR_";75///^S X=""@"""
|
|
. I $G(ENY2K("SHOPI"))>0 S DR=DR_";77////"_ENY2K("SHOPI")
|
|
. E S DR=DR_";77///^S X=""@"""
|
|
. I $G(ENY2K("NOTE"))]"" S DR=DR_";80///^S X=ENY2K(""NOTE"")"
|
|
I ENY2K("CODE")="NC" D
|
|
. I $G(ENY2K("ACT"))]"" S DR=DR_";76///^S X=ENY2K(""ACT"")"
|
|
. I $G(ENY2K("ACT"))="REP",$G(ENY2K("REPDT")) S DR=DR_";76.1///^S X=ENY2K(""REPDT"")"
|
|
. I $G(ENY2K("NOTE"))]"" S DR=DR_";80///^S X=ENY2K(""NOTE"")"
|
|
I ENY2K("CODE")="NA" D
|
|
. S DR=DR_";72///^S X=""@"";73///^S X=""@"";74///^S X=""@"";75///^S X=""@"";76///^S X=""@"";77///^S X=""@"""
|
|
S (DA,COUNT)=0 F S DA=$O(^TMP($J,DA)) Q:'DA D
|
|
. L +^ENG(6914,DA):10 I '$T W !,"Equipment Entry #"_DA_" is being edited by another user. Try again later." Q
|
|
. D ^DIE W:'(DA#10) "." S COUNT=COUNT+1
|
|
. I $G(ENY2K("NOTE"))]"" D
|
|
.. N ENX
|
|
.. S ENX(1)=ENY2K("NOTE")_" (Y2K note)"
|
|
.. D WP^DIE(6914,DA_",",40,"A","ENX") D MSG^DIALOG()
|
|
. L -^ENG(6914,DA)
|
|
W !,?10,COUNT_" equipment records were updated."
|
|
Q
|
|
;ENY2K1
|