ENSA7 ;(WASH ISC)/DH-Print Actual Test Results ;9-18-95
;;7.0;ENGINEERING;**21**;Aug 17, 1993
DEVICE ;Identify piece of equipment
I ENLBL?.N S ENEQ=ENLBL
I $E(ENLBL,3,8)[" EE" D
. I $D(^ENG(6914,"OEE",ENLBL)) S ENEQ=$O(^(ENLBL,0)) Q
. I $D(^ENG(6914,"EE",ENLBL)) S ENEQ=$O(^(ENLBL,0)) Q
. S ENEQ=+$P(ENLBL,"EE",2)
I ENLBL?4N1"-"4N0.1U S ENPMN=ENLBL,ENEQ=$O(^ENG(6914,"C",ENPMN,0))
I ENEQ="",ENMOD(0)]"",ENSN(0)]"",$D(^ENG(6914,"E",ENMOD(0))) F ENEQ=0:0 S ENEQ=$O(^ENG(6914,"E",ENMOD(0),ENEQ)) Q:ENEQ'>0 I $D(^ENG(6914,ENEQ,0)),$D(^(1)),$P(^(1),U,3)=ENSN(0) Q
I ENEQ>0,$D(^ENG(6914,ENEQ,0)) D DEVCK G:'$D(ENXP("?")) DEV1
Q:'ENPAPER W !,"DEVICE INFORMATION" W:'$D(ENXP("?")) " (* Item not found in Equipment File *)" W !
W ?5,X(1),!?5,X(2),!
Q
DEV1 Q:'ENPAPER W "Equipment ID: ",ENEQ,?40,"Location: ",ENLOC,!
S (ENCAT,ENSN,ENMOD,ENMAN,ENPMN)="" I $D(^ENG(6914,ENEQ,1)) S EN(1)=^(1),ENCAT=$P(EN(1),U,1),ENMOD=$P(EN(1),U,2),ENSN=$P(EN(1),U,3),ENMAN=$P(EN(1),U,4)
I ENCAT]"",$D(^ENG(6911,ENCAT,0)) S ENCAT=$P(^(0),U,1)
I ENMAN]"",$D(^ENG("MFG",ENMAN,0)) S ENMAN=$P(^(0),U,1)
K EN I $D(^ENG(6914,ENEQ,3)) S ENPMN=$P(^(3),U,6)
W ?5,"Equip Cat: ",ENCAT,?40,"Man: ",ENMAN,!
W ?5,"Mod: ",ENMOD,?30,"S/N: ",ENSN,?55,"PM#: ",ENPMN,!
Q
LNPRNT ;Print uploaded data
U IO S X=^ENG("TMP",ENTID,ENSA1)
I X["MedTester" S ENY=IOSL W:ENSA1>1 @IOF
Q:X']"" S X1=$E(X,1,4) W:X1="ECG:"!(X1="CASE") ?5
W X,!
Q
DEVCK ;Consistency check
K ENXP("?") I ENMOD(0)]"",ENSN(0)]"",$D(^ENG(6914,ENEQ,1)) G DEVCK1
Q ;Insufficient info - can't tell
DEVCK1 I $P(^ENG(6914,ENEQ,1),U,2)]"",$P(^(1),U,2)'=ENMOD(0) G DEVCK2
I $P(^ENG(6914,ENEQ,1),U,3)]"",$P(^(1),U,3)'=ENSN(0) G DEVCK2
I $D(^ENG(6914,ENEQ,3)),$D(ENPMN),$P(^(3),U,6)]"",$P(^(3),U,6)'=ENPMN G DEVCK2
Q ;OK
DEVCK2 ;Inconsistency
S ENXP("?")=1
Q
DEVCK3 S ENMSG="Please check MedTester REC # "_ENREC_" against Equipment File.",ENMSG(0,1)="Apparent inconsistency between Serial Numbers; Models; or (perhaps) VA PM#." D XCPTN^ENSA2
Q
;ENSA7
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENSA7 2040 printed Dec 13, 2024@01:55:35 Page 2
ENSA7 ;(WASH ISC)/DH-Print Actual Test Results ;9-18-95
+1 ;;7.0;ENGINEERING;**21**;Aug 17, 1993
DEVICE ;Identify piece of equipment
+1 IF ENLBL?.N
SET ENEQ=ENLBL
+2 IF $EXTRACT(ENLBL,3,8)[" EE"
Begin DoDot:1
+3 IF $DATA(^ENG(6914,"OEE",ENLBL))
SET ENEQ=$ORDER(^(ENLBL,0))
QUIT
+4 IF $DATA(^ENG(6914,"EE",ENLBL))
SET ENEQ=$ORDER(^(ENLBL,0))
QUIT
+5 SET ENEQ=+$PIECE(ENLBL,"EE",2)
End DoDot:1
+6 IF ENLBL?4N1"-"4N0.1U
SET ENPMN=ENLBL
SET ENEQ=$ORDER(^ENG(6914,"C",ENPMN,0))
+7 IF ENEQ=""
IF ENMOD(0)]""
IF ENSN(0)]""
IF $DATA(^ENG(6914,"E",ENMOD(0)))
FOR ENEQ=0:0
SET ENEQ=$ORDER(^ENG(6914,"E",ENMOD(0),ENEQ))
if ENEQ'>0
QUIT
IF $DATA(^ENG(6914,ENEQ,0))
IF $DATA(^(1))
IF $PIECE(^(1),U,3)=ENSN(0)
QUIT
+8 IF ENEQ>0
IF $DATA(^ENG(6914,ENEQ,0))
DO DEVCK
if '$DATA(ENXP("?"))
GOTO DEV1
+9 if 'ENPAPER
QUIT
WRITE !,"DEVICE INFORMATION"
if '$DATA(ENXP("?"))
WRITE " (* Item not found in Equipment File *)"
WRITE !
+10 WRITE ?5,X(1),!?5,X(2),!
+11 QUIT
DEV1 if 'ENPAPER
QUIT
WRITE "Equipment ID: ",ENEQ,?40,"Location: ",ENLOC,!
+1 SET (ENCAT,ENSN,ENMOD,ENMAN,ENPMN)=""
IF $DATA(^ENG(6914,ENEQ,1))
SET EN(1)=^(1)
SET ENCAT=$PIECE(EN(1),U,1)
SET ENMOD=$PIECE(EN(1),U,2)
SET ENSN=$PIECE(EN(1),U,3)
SET ENMAN=$PIECE(EN(1),U,4)
+2 IF ENCAT]""
IF $DATA(^ENG(6911,ENCAT,0))
SET ENCAT=$PIECE(^(0),U,1)
+3 IF ENMAN]""
IF $DATA(^ENG("MFG",ENMAN,0))
SET ENMAN=$PIECE(^(0),U,1)
+4 KILL EN
IF $DATA(^ENG(6914,ENEQ,3))
SET ENPMN=$PIECE(^(3),U,6)
+5 WRITE ?5,"Equip Cat: ",ENCAT,?40,"Man: ",ENMAN,!
+6 WRITE ?5,"Mod: ",ENMOD,?30,"S/N: ",ENSN,?55,"PM#: ",ENPMN,!
+7 QUIT
LNPRNT ;Print uploaded data
+1 USE IO
SET X=^ENG("TMP",ENTID,ENSA1)
+2 IF X["MedTester"
SET ENY=IOSL
if ENSA1>1
WRITE @IOF
+3 if X']""
QUIT
SET X1=$EXTRACT(X,1,4)
if X1="ECG
WRITE ?5
+4 WRITE X,!
+5 QUIT
DEVCK ;Consistency check
+1 KILL ENXP("?")
IF ENMOD(0)]""
IF ENSN(0)]""
IF $DATA(^ENG(6914,ENEQ,1))
GOTO DEVCK1
+2 ;Insufficient info - can't tell
QUIT
DEVCK1 IF $PIECE(^ENG(6914,ENEQ,1),U,2)]""
IF $PIECE(^(1),U,2)'=ENMOD(0)
GOTO DEVCK2
+1 IF $PIECE(^ENG(6914,ENEQ,1),U,3)]""
IF $PIECE(^(1),U,3)'=ENSN(0)
GOTO DEVCK2
+2 IF $DATA(^ENG(6914,ENEQ,3))
IF $DATA(ENPMN)
IF $PIECE(^(3),U,6)]""
IF $PIECE(^(3),U,6)'=ENPMN
GOTO DEVCK2
+3 ;OK
QUIT
DEVCK2 ;Inconsistency
+1 SET ENXP("?")=1
+2 QUIT
DEVCK3 SET ENMSG="Please check MedTester REC # "_ENREC_" against Equipment File."
SET ENMSG(0,1)="Apparent inconsistency between Serial Numbers; Models; or (perhaps) VA PM#."
DO XCPTN^ENSA2
+1 QUIT
+2 ;ENSA7
