source: FOIAVistA/tag/r/ENGINEERING-EN/ENY2K1.m@ 1507

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