- 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 Feb 18, 2025@23:23:36 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