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