- ENBCPM2 ;(WASH ISC)/DH-Bar Coded PMI ;4.9.97
- ;;7.0;ENGINEERING;**1,35**;Aug 17, 1993
- UPDATE ; Update File 6914
- N DIE,DA,DR,TAG
- I '$D(^ENG(6914,ENEQ,0)) S ENMSG="ITEM NOT IN DATABASE.",ENMSG(0,1)="Label was scanned incorrectly or Equipment File is corrupted." D XCPTN Q
- L +^ENG(6914,ENEQ):5 I '$T S ENMSG="RECORD LOCKED. Equipment ID#: "_ENEQ,ENMSG(0,1)="This record is being edited by another user at this time.",ENMSG(0,2)="Please update the inventory data manually." D XCPTN Q
- S TAG="XCPTN^ENBCPM2" D FLAG^ENEQNX2
- S ENOLDLOC=""
- I $P($G(^ENG(6914,ENEQ,2)),U,13)=DT D I ENOLDLOC=ENLOC L -^ENG(6914,ENEQ) Q ;Record already updated
- . S X=$P($G(^ENG(6914,ENEQ,3)),U,5) I X]"",X'["E",X=+X S ENOLDLOC=$P($G(^ENG("SP",X,0)),U)
- . Q:ENLOC=ENOLDLOC
- . I ENLOC["E" S ENOLDLOC=$TR(ENOLDLOC,"e","E")
- S ENLOC(0)=ENLOC
- I ENLOC]"",'$D(^ENG("SP","B",ENLOC)),ENLOC["E" F S ENLOC(0)=$P(ENLOC(0),"E")_"e"_$P(ENLOC(0),"E",2,99) I $D(^ENG("SP","B",ENLOC(0)))!(ENLOC(0)'["E") Q
- I '$D(^ENG("SP","B",ENLOC(0))) L -^ENG(6914,ENEQ) S ENMSG="BAD LOCATION",ENMSG(0,1)="Location not in Space File. Can't update the Equipment Record." D XCPTN Q
- S DIE="^ENG(6914,",DA=ENEQ,DR="24///^S X=ENLOC(0);23///^S X=DT"
- D ^DIE L -^ENG(6914,ENEQ)
- Q
- ;
- XCPTN ; Print Exception Messages
- U IO
- D:ENY=0!(ENY>(IOSL-5)) HDR W !!,ENMSG,! W:$D(ENLBL) " Label scanned as: ",ENLBL W:$D(ENLOC) " Location: ",ENLOC S ENY=ENY+3
- I $D(ENMSG(0)) F I=0:0 S I=$O(ENMSG(0,I)) Q:I'=+I W !,ENMSG(0,I) S ENY=ENY+1
- K ENMSG
- Q
- ;
- HDR ; New page for exception printing
- U IO
- I IO=IO(0),$E(IOST,1,2)="C-",ENY>0 D HOLD
- I ENPG!($E(IOST,1,2)="C-") W @IOF
- S ENPG=ENPG+1
- W "BAR CODED PMI EXCEPTION MESSAGES (Time stamp: "_ENCTTI(0)_")",?(IOM-8),ENDATE
- W !," Global Reference: ^PRCT(446.4,"_ENCTID_",2,"_ENCTTI_",1,",?(IOM-10),"Page ",ENPG
- K X S $P(X,"-",(IOM-1))="-" W !,X
- S ENY=4
- Q
- HOLD I $E(IOST,1,2)="C-" W !,"Press RETURN to continue..." R X:DTIME
- Q
- ZTSK ;Schedule processing for later time (from ENBCPM1)
- K IO("Q") S ZTIO=IO,ZTRTN="NEWLOC^ENBCPM1",ZTDESC="Record PMI (Bar code)",ZTSAVE("EN*")="",ZTSAVE("DT")=""
- D ^%ZTLOAD K ZTSK
- G EXIT^ENBCPM5
- ;ENBCPM2
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENBCPM2 2176 printed Jan 18, 2025@02:53:14 Page 2
- ENBCPM2 ;(WASH ISC)/DH-Bar Coded PMI ;4.9.97
- +1 ;;7.0;ENGINEERING;**1,35**;Aug 17, 1993
- UPDATE ; Update File 6914
- +1 NEW DIE,DA,DR,TAG
- +2 IF '$DATA(^ENG(6914,ENEQ,0))
- SET ENMSG="ITEM NOT IN DATABASE."
- SET ENMSG(0,1)="Label was scanned incorrectly or Equipment File is corrupted."
- DO XCPTN
- QUIT
- +3 LOCK +^ENG(6914,ENEQ):5
- IF '$TEST
- SET ENMSG="RECORD LOCKED. Equipment ID#: "_ENEQ
- SET ENMSG(0,1)="This record is being edited by another user at this time."
- SET ENMSG(0,2)="Please update the inventory data manually."
- DO XCPTN
- QUIT
- +4 SET TAG="XCPTN^ENBCPM2"
- DO FLAG^ENEQNX2
- +5 SET ENOLDLOC=""
- +6 ;Record already updated
- IF $PIECE($GET(^ENG(6914,ENEQ,2)),U,13)=DT
- Begin DoDot:1
- +7 SET X=$PIECE($GET(^ENG(6914,ENEQ,3)),U,5)
- IF X]""
- IF X'["E"
- IF X=+X
- SET ENOLDLOC=$PIECE($GET(^ENG("SP",X,0)),U)
- +8 if ENLOC=ENOLDLOC
- QUIT
- +9 IF ENLOC["E"
- SET ENOLDLOC=$TRANSLATE(ENOLDLOC,"e","E")
- End DoDot:1
- IF ENOLDLOC=ENLOC
- LOCK -^ENG(6914,ENEQ)
- QUIT
- +10 SET ENLOC(0)=ENLOC
- +11 IF ENLOC]""
- IF '$DATA(^ENG("SP","B",ENLOC))
- IF ENLOC["E"
- FOR
- SET ENLOC(0)=$PIECE(ENLOC(0),"E")_"e"_$PIECE(ENLOC(0),"E",2,99)
- IF $DATA(^ENG("SP","B",ENLOC(0)))!(ENLOC(0)'["E")
- QUIT
- +12 IF '$DATA(^ENG("SP","B",ENLOC(0)))
- LOCK -^ENG(6914,ENEQ)
- SET ENMSG="BAD LOCATION"
- SET ENMSG(0,1)="Location not in Space File. Can't update the Equipment Record."
- DO XCPTN
- QUIT
- +13 SET DIE="^ENG(6914,"
- SET DA=ENEQ
- SET DR="24///^S X=ENLOC(0);23///^S X=DT"
- +14 DO ^DIE
- LOCK -^ENG(6914,ENEQ)
- +15 QUIT
- +16 ;
- XCPTN ; Print Exception Messages
- +1 USE IO
- +2 if ENY=0!(ENY>(IOSL-5))
- DO HDR
- WRITE !!,ENMSG,!
- if $DATA(ENLBL)
- WRITE " Label scanned as: ",ENLBL
- if $DATA(ENLOC)
- WRITE " Location: ",ENLOC
- SET ENY=ENY+3
- +3 IF $DATA(ENMSG(0))
- FOR I=0:0
- SET I=$ORDER(ENMSG(0,I))
- if I'=+I
- QUIT
- WRITE !,ENMSG(0,I)
- SET ENY=ENY+1
- +4 KILL ENMSG
- +5 QUIT
- +6 ;
- HDR ; New page for exception printing
- +1 USE IO
- +2 IF IO=IO(0)
- IF $EXTRACT(IOST,1,2)="C-"
- IF ENY>0
- DO HOLD
- +3 IF ENPG!($EXTRACT(IOST,1,2)="C-")
- WRITE @IOF
- +4 SET ENPG=ENPG+1
- +5 WRITE "BAR CODED PMI EXCEPTION MESSAGES (Time stamp: "_ENCTTI(0)_")",?(IOM-8),ENDATE
- +6 WRITE !," Global Reference: ^PRCT(446.4,"_ENCTID_",2,"_ENCTTI_",1,",?(IOM-10),"Page ",ENPG
- +7 KILL X
- SET $PIECE(X,"-",(IOM-1))="-"
- WRITE !,X
- +8 SET ENY=4
- +9 QUIT
- HOLD IF $EXTRACT(IOST,1,2)="C-"
- WRITE !,"Press RETURN to continue..."
- READ X:DTIME
- +1 QUIT
- ZTSK ;Schedule processing for later time (from ENBCPM1)
- +1 KILL IO("Q")
- SET ZTIO=IO
- SET ZTRTN="NEWLOC^ENBCPM1"
- SET ZTDESC="Record PMI (Bar code)"
- SET ZTSAVE("EN*")=""
- SET ZTSAVE("DT")=""
- +2 DO ^%ZTLOAD
- KILL ZTSK
- +3 GOTO EXIT^ENBCPM5
- +4 ;ENBCPM2