Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ENY2K1

ENY2K1.m

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