ENEQP ;(WASH ISC)/DH-Direct Posting to Equipment Histories ;10.9.97
;;7.0;ENGINEERING;**45**;Aug 17, 1993
EN ;Post info to equipment history sub-file
N TEMPLT,NUMBER,QUIT,DIC S (ENTMPLT,QUIT)=0
W @IOF,!!,"This is a utility for posting information directly to the AEMS-MERS",!,"Equipment History sub-file."
W ! S DIR(0)="Y",DIR("A")="Are you sure you want to proceed",DIR("B")="NO"
D ^DIR G:Y'>0 EXIT
W !! S DIR(0)="Y",DIR("A")="Are the Equipment Records to be found in a SORT template",DIR("B")="NO"
D ^DIR K DIR I Y>0 D GTMPLT G:'ENTMPLT EXIT G POST
S DIR(0)="PO^6914:AEQM" K ^TMP($J)
F W ! D ^DIR Q:Y'>0 S ^TMP($J,+Y)=""
G:'$D(^TMP($J)) EXIT
S DIR(0)="Y",DIR("A")="Shall we save these ENTRY NUMBERS in a SORT template for future use",DIR("B")="NO"
W ! D ^DIR K DIR D:Y>0 STMPLT G:QUIT EXIT
;
POST W !!,"Enter as much information as may apply."
K DIR S DIR(0)="PO^6920.1:AEQM"
W ! D ^DIR K DIR S ENACTN=$S(Y>0:+Y,1:"") I $E(X)="^" G EXIT
S DIR(0)="FO^3:12",DIR("A")="WORK ORDER REFERENCE"
S DIR("?")="Enter 3 to 12 characters. Optional."
W ! D ^DIR K DIR G:$E(Y)="?" POST G:$E(Y)="^" EXIT
S ENREF=Y
S DIR(0)="SO^P:PASSED;C:CORRECTIVE ACTION REQUIRED;D:DEFERRED"
S DIR("A")="PM STATUS"
W ! D ^DIR K DIR S ENSTAT=$S(Y?1U:Y,1:"") I $E(X)="^" G EXIT
S DIR(0)="NO^0:2080:1",DIR("A")="TOTAL HOURS"
W ! D ^DIR S ENHRS=$S(Y=+Y:Y,1:"") K DIR I $E(X)="^" G EXIT
S DIR(0)="NO^0:999999:2",DIR("A")="LABOR COST"
W ! D ^DIR S ENLABOR=$S(Y=+Y:Y,1:"") K DIR I $E(X)="^" G EXIT
S DIR(0)="NO^0:999999:2",DIR("A")="MATERIAL COST"
W ! D ^DIR S ENMATRL=$S(Y=+Y:Y,1:"") K DIR I $E(X)="^" G EXIT
S DIR(0)="NO^0:999999:2",DIR("A")="VENDOR COST"
W ! D ^DIR S ENVNDR=$S(Y=+Y:Y,1:"") K DIR I $E(X)="^" G EXIT
S DIR(0)="FO^3:15",DIR("A")="WORKER",DIR("B")=$E($P(^VA(200,DUZ,0),U),1,15)
W ! D ^DIR S ENEMP=Y K DIR I $E(X)="^" G EXIT
S DIR(0)="FO^3:60",DIR("A")="WORK PERFORMED"
S DIR("?")="Free text. 60 character maximum."
W ! D ^DIR K DIR S ENWORK=Y I $E(X)="^" G EXIT
D ^ENEQP1
G EXIT
;
GTMPLT ;Get the SORT template
S DIC="^DIBT(",DIC(0)="AEQM",DIC("S")="I $E(^(0),1,6)=""ENPOST"",$P(^(0),U,4)=6914"
S DIC("A")="Select SORT template (must begin with 'ENPOST'): "
W ! D ^DIC K DIC("A") I Y>0 S ENTMPLT=1,NUMBER=+Y
Q
;
STMPLT ;Create new SORT template
W !! S DIR(0)="F^6:30^K:$E(X,1,6)'=""ENPOST"" X"
S DIR("A")="Name of SORT template. Must begin with 'ENPOST'",DIR("?")="Template name (30 char max) must begin with 'ENPOST' (upper case)."
D ^DIR K DIR I $E(X)="^" S QUIT=1 Q
S TEMPLT=Y
I $D(^DIBT("B",TEMPLT)) D Q
. F NUMBER=0:0 S NUMBER=$O(^DIBT("B",TEMPLT,NUMBER)) Q:NUMBER'>0 I $P(^DIBT(NUMBER,0),U,5)=DUZ,$P(^(0),U,4)=6914 D Q
.. W !!,"SORT template "_TEMPLT_" already exists."
.. S DIR(0)="Y",DIR("A")="OK to replace it"
.. D ^DIR K DIR I Y>0 D Q
... S DIK="^DIBT(",DA=NUMBER D ^DIK K DIK
... K DD,DO S DIC="^DIBT(",DIC(0)="X",X=TEMPLT,DINUM=NUMBER
... S DIC("DR")="2///^S X=DT;4///^S X=6914;5///^S X=DUZ"
... D FILE^DICN I Y'>0 S NUMBER=""
.. I $E(X)="^" S QUIT=1 Q
.. S DIR(0)="Y",DIR("A")="OK to add these entries"
.. D ^DIR K DIR I Y>0 D Q
... F %=0:0 S %=$O(^TMP($J,%)) Q:%'>0 S ^DIBT(NUMBER,1,%)=""
.. I $E(X)="^" S QUIT=1
CRE8 S DIR(0)="Y",DIR("A")="OK to create new SORT template"
S DIR("B")="YES"
D ^DIR K DIR S:$E(X)="^" QUIT=1 Q:Y'>0
K DD,DO S DIC="^DIBT(",DIC(0)="X",X=TEMPLT
S DIC("DR")="2///^S X=DT;4///^S X=6914;5///^S X=DUZ"
D FILE^DICN I Y>0 S NUMBER=+Y D
. F %=0:0 S %=$O(^TMP($J,%)) Q:%'>0 S ^DIBT(NUMBER,1,%)=""
Q
;
EXIT K ^TMP($J)
K ENTMPLT,ENREF,ENSTAT,ENHRS,ENLABOR,ENMATRL,ENVNDR,ENEMP,ENWORK
K ENACTN
Q
;ENEQP
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQP 3680 printed Oct 16, 2024@17:53:29 Page 2
ENEQP ;(WASH ISC)/DH-Direct Posting to Equipment Histories ;10.9.97
+1 ;;7.0;ENGINEERING;**45**;Aug 17, 1993
EN ;Post info to equipment history sub-file
+1 NEW TEMPLT,NUMBER,QUIT,DIC
SET (ENTMPLT,QUIT)=0
+2 WRITE @IOF,!!,"This is a utility for posting information directly to the AEMS-MERS",!,"Equipment History sub-file."
+3 WRITE !
SET DIR(0)="Y"
SET DIR("A")="Are you sure you want to proceed"
SET DIR("B")="NO"
+4 DO ^DIR
if Y'>0
GOTO EXIT
+5 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Are the Equipment Records to be found in a SORT template"
SET DIR("B")="NO"
+6 DO ^DIR
KILL DIR
IF Y>0
DO GTMPLT
if 'ENTMPLT
GOTO EXIT
GOTO POST
+7 SET DIR(0)="PO^6914:AEQM"
KILL ^TMP($JOB)
+8 FOR
WRITE !
DO ^DIR
if Y'>0
QUIT
SET ^TMP($JOB,+Y)=""
+9 if '$DATA(^TMP($JOB))
GOTO EXIT
+10 SET DIR(0)="Y"
SET DIR("A")="Shall we save these ENTRY NUMBERS in a SORT template for future use"
SET DIR("B")="NO"
+11 WRITE !
DO ^DIR
KILL DIR
if Y>0
DO STMPLT
if QUIT
GOTO EXIT
+12 ;
POST WRITE !!,"Enter as much information as may apply."
+1 KILL DIR
SET DIR(0)="PO^6920.1:AEQM"
+2 WRITE !
DO ^DIR
KILL DIR
SET ENACTN=$SELECT(Y>0:+Y,1:"")
IF $EXTRACT(X)="^"
GOTO EXIT
+3 SET DIR(0)="FO^3:12"
SET DIR("A")="WORK ORDER REFERENCE"
+4 SET DIR("?")="Enter 3 to 12 characters. Optional."
+5 WRITE !
DO ^DIR
KILL DIR
if $EXTRACT(Y)="?"
GOTO POST
if $EXTRACT(Y)="^"
GOTO EXIT
+6 SET ENREF=Y
+7 SET DIR(0)="SO^P:PASSED;C:CORRECTIVE ACTION REQUIRED;D:DEFERRED"
+8 SET DIR("A")="PM STATUS"
+9 WRITE !
DO ^DIR
KILL DIR
SET ENSTAT=$SELECT(Y?1U:Y,1:"")
IF $EXTRACT(X)="^"
GOTO EXIT
+10 SET DIR(0)="NO^0:2080:1"
SET DIR("A")="TOTAL HOURS"
+11 WRITE !
DO ^DIR
SET ENHRS=$SELECT(Y=+Y:Y,1:"")
KILL DIR
IF $EXTRACT(X)="^"
GOTO EXIT
+12 SET DIR(0)="NO^0:999999:2"
SET DIR("A")="LABOR COST"
+13 WRITE !
DO ^DIR
SET ENLABOR=$SELECT(Y=+Y:Y,1:"")
KILL DIR
IF $EXTRACT(X)="^"
GOTO EXIT
+14 SET DIR(0)="NO^0:999999:2"
SET DIR("A")="MATERIAL COST"
+15 WRITE !
DO ^DIR
SET ENMATRL=$SELECT(Y=+Y:Y,1:"")
KILL DIR
IF $EXTRACT(X)="^"
GOTO EXIT
+16 SET DIR(0)="NO^0:999999:2"
SET DIR("A")="VENDOR COST"
+17 WRITE !
DO ^DIR
SET ENVNDR=$SELECT(Y=+Y:Y,1:"")
KILL DIR
IF $EXTRACT(X)="^"
GOTO EXIT
+18 SET DIR(0)="FO^3:15"
SET DIR("A")="WORKER"
SET DIR("B")=$EXTRACT($PIECE(^VA(200,DUZ,0),U),1,15)
+19 WRITE !
DO ^DIR
SET ENEMP=Y
KILL DIR
IF $EXTRACT(X)="^"
GOTO EXIT
+20 SET DIR(0)="FO^3:60"
SET DIR("A")="WORK PERFORMED"
+21 SET DIR("?")="Free text. 60 character maximum."
+22 WRITE !
DO ^DIR
KILL DIR
SET ENWORK=Y
IF $EXTRACT(X)="^"
GOTO EXIT
+23 DO ^ENEQP1
+24 GOTO EXIT
+25 ;
GTMPLT ;Get the SORT template
+1 SET DIC="^DIBT("
SET DIC(0)="AEQM"
SET DIC("S")="I $E(^(0),1,6)=""ENPOST"",$P(^(0),U,4)=6914"
+2 SET DIC("A")="Select SORT template (must begin with 'ENPOST'): "
+3 WRITE !
DO ^DIC
KILL DIC("A")
IF Y>0
SET ENTMPLT=1
SET NUMBER=+Y
+4 QUIT
+5 ;
STMPLT ;Create new SORT template
+1 WRITE !!
SET DIR(0)="F^6:30^K:$E(X,1,6)'=""ENPOST"" X"
+2 SET DIR("A")="Name of SORT template. Must begin with 'ENPOST'"
SET DIR("?")="Template name (30 char max) must begin with 'ENPOST' (upper case)."
+3 DO ^DIR
KILL DIR
IF $EXTRACT(X)="^"
SET QUIT=1
QUIT
+4 SET TEMPLT=Y
+5 IF $DATA(^DIBT("B",TEMPLT))
Begin DoDot:1
+6 FOR NUMBER=0:0
SET NUMBER=$ORDER(^DIBT("B",TEMPLT,NUMBER))
if NUMBER'>0
QUIT
IF $PIECE(^DIBT(NUMBER,0),U,5)=DUZ
IF $PIECE(^(0),U,4)=6914
Begin DoDot:2
+7 WRITE !!,"SORT template "_TEMPLT_" already exists."
+8 SET DIR(0)="Y"
SET DIR("A")="OK to replace it"
+9 DO ^DIR
KILL DIR
IF Y>0
Begin DoDot:3
+10 SET DIK="^DIBT("
SET DA=NUMBER
DO ^DIK
KILL DIK
+11 KILL DD,DO
SET DIC="^DIBT("
SET DIC(0)="X"
SET X=TEMPLT
SET DINUM=NUMBER
+12 SET DIC("DR")="2///^S X=DT;4///^S X=6914;5///^S X=DUZ"
+13 DO FILE^DICN
IF Y'>0
SET NUMBER=""
End DoDot:3
QUIT
+14 IF $EXTRACT(X)="^"
SET QUIT=1
QUIT
+15 SET DIR(0)="Y"
SET DIR("A")="OK to add these entries"
+16 DO ^DIR
KILL DIR
IF Y>0
Begin DoDot:3
+17 FOR %=0:0
SET %=$ORDER(^TMP($JOB,%))
if %'>0
QUIT
SET ^DIBT(NUMBER,1,%)=""
End DoDot:3
QUIT
+18 IF $EXTRACT(X)="^"
SET QUIT=1
End DoDot:2
QUIT
End DoDot:1
QUIT
CRE8 SET DIR(0)="Y"
SET DIR("A")="OK to create new SORT template"
+1 SET DIR("B")="YES"
+2 DO ^DIR
KILL DIR
if $EXTRACT(X)="^"
SET QUIT=1
if Y'>0
QUIT
+3 KILL DD,DO
SET DIC="^DIBT("
SET DIC(0)="X"
SET X=TEMPLT
+4 SET DIC("DR")="2///^S X=DT;4///^S X=6914;5///^S X=DUZ"
+5 DO FILE^DICN
IF Y>0
SET NUMBER=+Y
Begin DoDot:1
+6 FOR %=0:0
SET %=$ORDER(^TMP($JOB,%))
if %'>0
QUIT
SET ^DIBT(NUMBER,1,%)=""
End DoDot:1
+7 QUIT
+8 ;
EXIT KILL ^TMP($JOB)
+1 KILL ENTMPLT,ENREF,ENSTAT,ENHRS,ENLABOR,ENMATRL,ENVNDR,ENEMP,ENWORK
+2 KILL ENACTN
+3 QUIT
+4 ;ENEQP
