- ENEQNX1 ;(WASH ISC)/DH-Process Uploaded Equipment Inventory ;1/9/2001
- ;;7.0;ENGINEERING;**10,21,45,68,96**;Aug 17, 1993;Build 5
- RES ;Restart an aborted process
- S X="",ENY=0 W !!,"Enter PROCESS ID: " R X:DTIME G:X="^"!(X="") EXIT^ENEQNX2 S ENCTID=$O(^PRCT(446.4,"C",X,"")) I ENCTID="" W !!,*7,"Wrong application. Aborting..." D HOLD G EXIT^ENEQNX2
- S X="" W !!,"Enter TIME STAMP of process to be restarted: " R X:DTIME G:X="^"!(X="") EXIT^ENEQNX2 S ENCTTI=$O(^PRCT(446.4,ENCTID,2,"B",X,"")) I ENCTTI="" W !!,"NO DATA. Aborting..." D HOLD G EXIT^ENEQNX2
- EN ;Main entry point. Expects ENCTID and ENCTTI.
- G:'$D(ENCTID) ERR^ENEQNX3
- S ENSTA=$P($G(^DIC(6910,1,0)),U,2),ENSTAL=$L(ENSTA)
- I ENSTA="" W !!,"Can't seem to find your STATION NUMBER. Please check File 6910.",!,"Your IRM staff may need to assist you.",*7 G ERR^ENEQNX3
- F I=1,2,3,4,5,6,7,8 S ENSTA(I)="",ENSTAL(I)=0
- I $G(^DIC(6910,1,3,0))]"" D
- . S (I,ENX)=0 F S ENX=$O(^DIC(6910,1,3,ENX)) Q:'ENX!(I>8) D
- .. S I=I+1,ENSTA(I)=$P(^DIC(6910,1,3,ENX,0),U)
- .. S ENSTAL(I)=$L(ENSTA(I))
- S X="T",U="^",%DT="" D ^%DT S DT=+Y X ^DD("DD") S ENDATE=Y I '$D(DTIME) S DTIME=600
- D MSG^ENEQNX3
- S %ZIS="Q",%ZIS("A")="Select Device for Exception Messages: " D ^%ZIS K %ZIS G:POP ERR^ENEQNX3
- G:$D(IO("Q")) ZTSK
- CONT ;Physical processing of uploaded data
- U IO S (ENY,ENPG)=0,ENX=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,0)) I ENX'>0 D HDR W *7,!!,"No data to process." D HOLD G EXIT^ENEQNX2
- S ENX=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)) ;ignore file ID
- ; *96 write a msg if no data
- I 'ENX D HDR W *7,!!,"No data to process." G EXIT^ENEQNX2
- NEWLOC ;Beginning of a specific location
- S ENLBL=^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0),ENLOC=$E(ENLBL,3,50) I $E(ENLBL,1,2)'="SP" S ENMSG="LOCATION EXPECTED." D XCPTN S ENX=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)) G:ENX'>0 EXIT^ENEQNX2 G NEWLOC
- I ENLOC[" " S ENLOC=$P(ENLOC," ")
- S X=$L(ENLOC) I $E(ENLOC,X)=" " S ENLOC=$E(ENLOC,1,(X-1))
- NEWNX ;Process a piece of equipment
- S ENX=$O(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX)) G:ENX'>0 DONE S (ENEQ,ENLBL)=^(ENX,0) G:$E(ENLBL)="*" NEWNX
- I $E(ENEQ,1,2)="SP" K ENEQ G NEWLOC
- S ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)="*"_ENEQ
- I $E(ENEQ,1,4)="MOD:" D NOLBL^ENEQNX3 G NEWNX
- I $E(ENEQ,1,4)="PM#:" D PMN^ENEQNX3 G NEWNX
- I ENEQ[" EE",$P(ENEQ," ")'=ENSTA D I $D(ENMSG) D XCPTN G NEWNX
- . K ENMSG S ENMSG="FOREIGN EQUIPMENT."
- . F I=1:1:8 I ENSTAL(I),ENSTA(I)=$E(ENEQ,1,ENSTAL(I)) K ENMSG Q
- . I $D(ENMSG) S ENMSG(0,1)="Cannot process a bar code label from another VAMC."
- S ENEQ=$S($D(^ENG(6914,"OEE",ENLBL)):$O(^(ENLBL,0)),1:+$P(ENLBL,"EE",2))
- I ENEQ>0 D UPDATE^ENEQNX2
- G NEWNX
- ;
- XCPTN ;Print Exception Messages
- 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
- I $E(IOST,1,2)="C-",ENY>0 D HOLD
- I ENPG!($E(IOST,1,2)="C-") W @IOF
- S ENPG=ENPG+1
- W "NON-EXPENDABLE INVENTORY EXCEPTION MESSAGES",?(IOM-15),ENDATE
- W !," Global Reference: ^PRCT(446.4,"_ENCTID_",2,"_ENCTTI_",1,",?(IOM-15),"Page ",ENPG
- K % S $P(%,"-",(IOM-1))="-" W !,%
- S ENY=4
- Q
- ZTSK ;Queue processing for later time
- K IO("Q") S ZTIO=ION,ZTRTN="CONT^ENEQNX1",ZTDESC="NX Inventory (Bar Code)"
- F I="ENSTA","ENSTA(","ENSTAL","ENSTAL(","ENCTTI","ENCTID","DT","ENDATE" S ZTSAVE(I)=""
- D ^%ZTLOAD K ZTSK D HOME^%ZIS
- G EXIT^ENEQNX2
- HOLD I $E(IOST,1,2)="C-" W !,"Press <RETURN> to continue..." R X:DTIME
- Q
- DONE ;Delete DATE/TIME OF DATA UPLOAD
- K DA,DIK S DIK="^PRCT(446.4,"_ENCTID_",2,",DA(1)=ENCTID,DA=ENCTTI
- D ^DIK
- K DIK
- G EXIT^ENEQNX2
- ;ENEQNX1
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENEQNX1 3721 printed Jan 18, 2025@02:53:48 Page 2
- ENEQNX1 ;(WASH ISC)/DH-Process Uploaded Equipment Inventory ;1/9/2001
- +1 ;;7.0;ENGINEERING;**10,21,45,68,96**;Aug 17, 1993;Build 5
- RES ;Restart an aborted process
- +1 SET X=""
- SET ENY=0
- WRITE !!,"Enter PROCESS ID: "
- READ X:DTIME
- if X="^"!(X="")
- GOTO EXIT^ENEQNX2
- SET ENCTID=$ORDER(^PRCT(446.4,"C",X,""))
- IF ENCTID=""
- WRITE !!,*7,"Wrong application. Aborting..."
- DO HOLD
- GOTO EXIT^ENEQNX2
- +2 SET X=""
- WRITE !!,"Enter TIME STAMP of process to be restarted: "
- READ X:DTIME
- if X="^"!(X="")
- GOTO EXIT^ENEQNX2
- SET ENCTTI=$ORDER(^PRCT(446.4,ENCTID,2,"B",X,""))
- IF ENCTTI=""
- WRITE !!,"NO DATA. Aborting..."
- DO HOLD
- GOTO EXIT^ENEQNX2
- EN ;Main entry point. Expects ENCTID and ENCTTI.
- +1 if '$DATA(ENCTID)
- GOTO ERR^ENEQNX3
- +2 SET ENSTA=$PIECE($GET(^DIC(6910,1,0)),U,2)
- SET ENSTAL=$LENGTH(ENSTA)
- +3 IF ENSTA=""
- WRITE !!,"Can't seem to find your STATION NUMBER. Please check File 6910.",!,"Your IRM staff may need to assist you.",*7
- GOTO ERR^ENEQNX3
- +4 FOR I=1,2,3,4,5,6,7,8
- SET ENSTA(I)=""
- SET ENSTAL(I)=0
- +5 IF $GET(^DIC(6910,1,3,0))]""
- Begin DoDot:1
- +6 SET (I,ENX)=0
- FOR
- SET ENX=$ORDER(^DIC(6910,1,3,ENX))
- if 'ENX!(I>8)
- QUIT
- Begin DoDot:2
- +7 SET I=I+1
- SET ENSTA(I)=$PIECE(^DIC(6910,1,3,ENX,0),U)
- +8 SET ENSTAL(I)=$LENGTH(ENSTA(I))
- End DoDot:2
- End DoDot:1
- +9 SET X="T"
- SET U="^"
- SET %DT=""
- DO ^%DT
- SET DT=+Y
- XECUTE ^DD("DD")
- SET ENDATE=Y
- IF '$DATA(DTIME)
- SET DTIME=600
- +10 DO MSG^ENEQNX3
- +11 SET %ZIS="Q"
- SET %ZIS("A")="Select Device for Exception Messages: "
- DO ^%ZIS
- KILL %ZIS
- if POP
- GOTO ERR^ENEQNX3
- +12 if $DATA(IO("Q"))
- GOTO ZTSK
- CONT ;Physical processing of uploaded data
- +1 USE IO
- SET (ENY,ENPG)=0
- SET ENX=$ORDER(^PRCT(446.4,ENCTID,2,ENCTTI,1,0))
- IF ENX'>0
- DO HDR
- WRITE *7,!!,"No data to process."
- DO HOLD
- GOTO EXIT^ENEQNX2
- +2 ;ignore file ID
- SET ENX=$ORDER(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX))
- +3 ; *96 write a msg if no data
- +4 IF 'ENX
- DO HDR
- WRITE *7,!!,"No data to process."
- GOTO EXIT^ENEQNX2
- NEWLOC ;Beginning of a specific location
- +1 SET ENLBL=^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)
- SET ENLOC=$EXTRACT(ENLBL,3,50)
- IF $EXTRACT(ENLBL,1,2)'="SP"
- SET ENMSG="LOCATION EXPECTED."
- DO XCPTN
- SET ENX=$ORDER(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX))
- if ENX'>0
- GOTO EXIT^ENEQNX2
- GOTO NEWLOC
- +2 IF ENLOC[" "
- SET ENLOC=$PIECE(ENLOC," ")
- +3 SET X=$LENGTH(ENLOC)
- IF $EXTRACT(ENLOC,X)=" "
- SET ENLOC=$EXTRACT(ENLOC,1,(X-1))
- NEWNX ;Process a piece of equipment
- +1 SET ENX=$ORDER(^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX))
- if ENX'>0
- GOTO DONE
- SET (ENEQ,ENLBL)=^(ENX,0)
- if $EXTRACT(ENLBL)="*"
- GOTO NEWNX
- +2 IF $EXTRACT(ENEQ,1,2)="SP"
- KILL ENEQ
- GOTO NEWLOC
- +3 SET ^PRCT(446.4,ENCTID,2,ENCTTI,1,ENX,0)="*"_ENEQ
- +4 IF $EXTRACT(ENEQ,1,4)="MOD:"
- DO NOLBL^ENEQNX3
- GOTO NEWNX
- +5 IF $EXTRACT(ENEQ,1,4)="PM#:"
- DO PMN^ENEQNX3
- GOTO NEWNX
- +6 IF ENEQ[" EE"
- IF $PIECE(ENEQ," ")'=ENSTA
- Begin DoDot:1
- +7 KILL ENMSG
- SET ENMSG="FOREIGN EQUIPMENT."
- +8 FOR I=1:1:8
- IF ENSTAL(I)
- IF ENSTA(I)=$EXTRACT(ENEQ,1,ENSTAL(I))
- KILL ENMSG
- QUIT
- +9 IF $DATA(ENMSG)
- SET ENMSG(0,1)="Cannot process a bar code label from another VAMC."
- End DoDot:1
- IF $DATA(ENMSG)
- DO XCPTN
- GOTO NEWNX
- +10 SET ENEQ=$SELECT($DATA(^ENG(6914,"OEE",ENLBL)):$ORDER(^(ENLBL,0)),1:+$PIECE(ENLBL,"EE",2))
- +11 IF ENEQ>0
- DO UPDATE^ENEQNX2
- +12 GOTO NEWNX
- +13 ;
- XCPTN ;Print Exception Messages
- +1 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
- +2 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
- +3 KILL ENMSG
- +4 QUIT
- +5 ;
- HDR ;New page for exception printing
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF ENY>0
- DO HOLD
- +2 IF ENPG!($EXTRACT(IOST,1,2)="C-")
- WRITE @IOF
- +3 SET ENPG=ENPG+1
- +4 WRITE "NON-EXPENDABLE INVENTORY EXCEPTION MESSAGES",?(IOM-15),ENDATE
- +5 WRITE !," Global Reference: ^PRCT(446.4,"_ENCTID_",2,"_ENCTTI_",1,",?(IOM-15),"Page ",ENPG
- +6 KILL %
- SET $PIECE(%,"-",(IOM-1))="-"
- WRITE !,%
- +7 SET ENY=4
- +8 QUIT
- ZTSK ;Queue processing for later time
- +1 KILL IO("Q")
- SET ZTIO=ION
- SET ZTRTN="CONT^ENEQNX1"
- SET ZTDESC="NX Inventory (Bar Code)"
- +2 FOR I="ENSTA","ENSTA(","ENSTAL","ENSTAL(","ENCTTI","ENCTID","DT","ENDATE"
- SET ZTSAVE(I)=""
- +3 DO ^%ZTLOAD
- KILL ZTSK
- DO HOME^%ZIS
- +4 GOTO EXIT^ENEQNX2
- HOLD IF $EXTRACT(IOST,1,2)="C-"
- WRITE !,"Press <RETURN> to continue..."
- READ X:DTIME
- +1 QUIT
- DONE ;Delete DATE/TIME OF DATA UPLOAD
- +1 KILL DA,DIK
- SET DIK="^PRCT(446.4,"_ENCTID_",2,"
- SET DA(1)=ENCTID
- SET DA=ENCTTI
- +2 DO ^DIK
- +3 KILL DIK
- +4 GOTO EXIT^ENEQNX2
- +5 ;ENEQNX1