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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENY2K1 3926 printed Apr 09, 2024@20:56:39 Page 2
ENY2K1 ;;(WIRMFO)/DH-Equipment Y2K Data Acq ;1.15.99
+1 ;;7.0;ENGINEERING;**51,55,61**;August 17, 1993
DATA ; ask user for Y2K fields
+1 ; loc var ESCAPE set to 1 for escape from procedure, otherwise undef
+2 NEW DA,J
+3 FOR J="CODE","DATE","COST","TECHI","TECHE","SHOPI","SHOPE","ACT","SOURCE","NOTE","CLASS","UTIL","REPDT"
SET ENY2K(J)=""
+4 SET DIR(0)="6914,71"
SET DIR("A")="Please select the Y2K CATEGORY"
SET DIR("B")="CC"
+5 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ESCAPE=1
QUIT
+6 SET ENY2K("CODE")=$PIECE(Y,U)
+7 SET DIR(0)="6914,71.5"
SET DIR("B")="LOCAL ASSESSMENT"
+8 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ESCAPE=1
QUIT
+9 SET ENY2K("SOURCE")=$PIECE(Y,U)
+10 SET DIR(0)="6914,81"
SET DIR("B")="Medical device"
+11 DO ^DIR
KILL DIR
IF $DATA(DIRUT)
SET ESCAPE=1
QUIT
+12 SET ENY2K("CLASS")=$PIECE(Y,U)
+13 IF ENY2K("CLASS")="FS"
Begin DoDot:1
+14 SET DIR(0)="6914,82O"
+15 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET ESCAPE=1
QUIT
+16 SET ENY2K("UTIL")=$PIECE(Y,U)
End DoDot:1
if $GET(ESCAPE)
QUIT
+17 IF ENY2K("CODE")="CC"
Begin DoDot:1
+18 SET DIR(0)="6914,72"
SET DIR("A")="Enter ESTIMATED Y2K COMPLIANCE DATE"
+19 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET ESCAPE=1
QUIT
+20 SET ENY2K("DATE")=Y
+21 SET DIR(0)="6914,73"
SET DIR("A")="Enter ESTIMATED Y2K COMPLIANCE COST"
+22 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET ESCAPE=1
QUIT
+23 SET ENY2K("COST")=Y
+24 SET DIR(0)="6914,75"
SET DIR("A")="Technician responsible for Y2K upgrade"
+25 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET ESCAPE=1
QUIT
+26 SET ENY2K("TECHI")=+Y
SET ENY2K("TECHE")=$PIECE(Y,U,2)
+27 SET DIC="^DIC(6922,"
SET DIC(0)="AEQM"
SET DIC("A")="Engineering Section responsible for Y2K upgrade: "
+28 IF $GET(ENY2K("TECHI"))>0
IF $PIECE(^ENG("EMP",ENY2K("TECHI"),0),U,10)>0
SET DIC("B")=$$GET1^DIQ(6929,ENY2K("TECHI"),.3)
+29 DO ^DIC
KILL DIC
IF $DATA(DTOUT)!($DATA(DUOUT))
SET ESCAPE=1
QUIT
+30 SET ENY2K("SHOPI")=+Y
SET ENY2K("SHOPE")=$PIECE(Y,U,2)
+31 SET DIR(0)="6914,80"
SET DIR("A")="Notation to appear on Y2K worklist (80 char max)"
+32 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET ESCAPE=1
QUIT
+33 SET ENY2K("NOTE")=$PIECE(Y,U)
End DoDot:1
QUIT
+34 IF ENY2K("CODE")="NC"
Begin DoDot:1
+35 SET DIR(0)="6914,76"
SET DIR("A")="Enter the planned Y2K ACTION"
+36 SET DIR("?")="What do you plan to do with these non-compliant devices?"
+37 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET ESCAPE=1
QUIT
+38 SET ENY2K("ACT")=$PIECE(Y,U)
+39 IF ENY2K("ACT")="REP"
Begin DoDot:2
+40 SET DIR(0)="6914,76.1O"
+41 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET ESCAPE=1
QUIT
+42 SET ENY2K("REPDT")=$PIECE(Y,U)
End DoDot:2
if $GET(ESCAPE)
QUIT
+43 SET DIR(0)="6914,80"
SET DIR("A")="Notation to be appended to equipment COMMENTS (80 char max)"
+44 DO ^DIR
KILL DIR
IF $DATA(DTOUT)!($DATA(DUOUT))
SET ESCAPE=1
QUIT
+45 SET ENY2K("NOTE")=Y
End DoDot:1
QUIT
+46 ; return control to ENY2K
QUIT
+47 ;
UPDATE ; update Y2K fields of conditionally compliant and non-compliant
+1 ; equipment record(s)
+2 SET DIE="^ENG(6914,"
SET DR="71///^S X=ENY2K(""CODE"");71.5///^S X=ENY2K(""SOURCE"");81///^S X=ENY2K(""CLASS"")"
+3 IF ENY2K("CLASS")="FS"
IF $GET(ENY2K("UTIL"))
SET DR=DR_";82///^S X=ENY2K(""UTIL"")"
+4 IF ENY2K("CODE")="CC"
Begin DoDot:1
+5 IF $GET(ENY2K("DATE"))?7N
SET DR=DR_";72///^S X=ENY2K(""DATE"")"
+6 IF $GET(ENY2K("COST"))
SET DR=DR_";73///^S X=ENY2K(""COST"")"
+7 IF $GET(ENY2K("TECHI"))>0
SET DR=DR_";75////"_ENY2K("TECHI")
+8 IF '$TEST
SET DR=DR_";75///^S X=""@"""
+9 IF $GET(ENY2K("SHOPI"))>0
SET DR=DR_";77////"_ENY2K("SHOPI")
+10 IF '$TEST
SET DR=DR_";77///^S X=""@"""
+11 IF $GET(ENY2K("NOTE"))]""
SET DR=DR_";80///^S X=ENY2K(""NOTE"")"
End DoDot:1
+12 IF ENY2K("CODE")="NC"
Begin DoDot:1
+13 IF $GET(ENY2K("ACT"))]""
SET DR=DR_";76///^S X=ENY2K(""ACT"")"
+14 IF $GET(ENY2K("ACT"))="REP"
IF $GET(ENY2K("REPDT"))
SET DR=DR_";76.1///^S X=ENY2K(""REPDT"")"
+15 IF $GET(ENY2K("NOTE"))]""
SET DR=DR_";80///^S X=ENY2K(""NOTE"")"
End DoDot:1
+16 IF ENY2K("CODE")="NA"
Begin DoDot:1
+17 SET DR=DR_";72///^S X=""@"";73///^S X=""@"";74///^S X=""@"";75///^S X=""@"";76///^S X=""@"";77///^S X=""@"""
End DoDot:1
+18 SET (DA,COUNT)=0
FOR
SET DA=$ORDER(^TMP($JOB,DA))
if 'DA
QUIT
Begin DoDot:1
+19 LOCK +^ENG(6914,DA):10
IF '$TEST
WRITE !,"Equipment Entry #"_DA_" is being edited by another user. Try again later."
QUIT
+20 DO ^DIE
if '(DA#10)
WRITE "."
SET COUNT=COUNT+1
+21 IF $GET(ENY2K("NOTE"))]""
Begin DoDot:2
+22 NEW ENX
+23 SET ENX(1)=ENY2K("NOTE")_" (Y2K note)"
+24 DO WP^DIE(6914,DA_",",40,"A","ENX")
DO MSG^DIALOG()
End DoDot:2
+25 LOCK -^ENG(6914,DA)
End DoDot:1
+26 WRITE !,?10,COUNT_" equipment records were updated."
+27 QUIT
+28 ;ENY2K1
