ENTIRRE ;WOIFO/SAB - IT Equipment Report ;2/4/2008
;;7.0;ENGINEERING;**87**;Aug 17, 1993;Build 16
;
N ENIA,ENKTMP,ENSM,ENSMV,ENSRT,ENX
;
; ask equipment selection method
S ENX=$$ASKEQSM^ENTIUTL2("AECULS")
S ENSM=$P(ENX,U),ENSMV=$P(ENX,U,2)
Q:"^A^E^C^U^L^S^"'[(U_ENSM_U)
;
; ask sort
S ENSRT=$$ASKEQSRT^ENTIUTL2(ENSM)
Q:ENSRT="" ; user time-out or '^'
;
S ENIA=1 ; include equipment with active assignments
;
; if method is E then obtain list of equipment
I ENSM="E" D GETEQ^ENTIUTL2(ENSM,ENSMV,ENSRT,ENIA)
;
S ENKTMP=1 ; flag to kill TMP global
;
AEN ; entry point from ENTIRA routine (with it's list of equipment in ^TMP)
N ENBFMT
;
; ask format
S DIR(0)="Y"
S DIR("A")="Do you want the brief display format"
S DIR("B")="YES"
D ^DIR K DIR G:$D(DIRUT) EXIT
S ENBFMT=Y
;
; ask device
S %ZIS="Q" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. N ENY
. S ZTRTN="QEN^ENTIRRE",ZTDESC="IT Equipment Report"
. F ENY="ENSM","ENSMV","ENIA","ENSRT","ENBFMT","ENKTMP" S ZTSAVE(ENY)=""
. S ZTSAVE("^TMP($J,""ENITEQ"",")=""
. D ^%ZTLOAD,HOME^%ZIS K ZTSK,IO("Q")
;
QEN ; queued entry
U IO
;
; generate output
K ENT S ENT=0
S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDT=Y
;
; build header line 2 string
S ENHL2=$$BLDHL2^ENTIUTL(ENSM,ENSMV,ENSRT)
;
D HD
;
; if sorted equipment list is not already built then build it
I '$D(^TMP($J,"ENITEQ")) D GETEQ^ENTIUTL2(ENSM,ENSMV,ENSRT,ENIA)
;
; print equipment
; loop thru sort value
S ENSRTV=""
F S ENSRTV=$O(^TMP($J,"ENITEQ",ENSRTV)) Q:ENSRTV="" D Q:END
. ; loop thru equipment
. S ENDA=0
. F S ENDA=$O(^TMP($J,"ENITEQ",ENSRTV,ENDA)) Q:'ENDA D Q:END
. . S ENT=ENT+1
. . ; display equipment data
. . I $Y+$S(ENBFMT:5,1:8)>IOSL D HD Q:END
. . I ENBFMT D
. . . S ENCMR=$$GET1^DIQ(6914,ENDA,19)
. . . S ENLOC=$$GET1^DIQ(6914,ENDA,24)
. . . S ENSVC=$$GET1^DIQ(6914,ENDA,21)
. . . S ENNAM=$$GET1^DIQ(6914,ENDA,3)
. . . W !,ENDA,?12,ENCMR,?19,ENLOC,?41,ENSVC
. . . W !,?2,$E(ENNAM,1,78)
. . E D CAPEQ^ENTIUTL(ENDA,"HD^ENTIRRE",,.END) Q:END
. . ; display assignments
. . D DISASGN(ENDA)
. . W !
;
I 'END D
. ; report footer
. I $Y+4>IOSL D HD Q:END
. W !!,"Count of IT equipment items on report = ",ENT
. I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
;
D ^%ZISC
;
EXIT I $D(ZTQUEUED) S ZTREQ="@"
I $G(ENKTMP) K ^TMP($J,"ENITEQ")
K DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,POP,X,Y
K ENCMR,ENDA,ENHL2,ENKTMP,ENLOC,ENNAM,ENNSP,ENSM,ENSMV
K ENSRT,ENSRTV,ENSVC,ENT,END,ENDT,ENPG
Q
;
HD ; header
I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
I $E(IOST,1,2)="C-"!ENPG W @IOF
S ENPG=ENPG+1
W "IT EQUIPMENT REPORT",?48,ENDT,?72,"page ",ENPG
W !,ENHL2,!
I ENBFMT D
. W !,"Entry #",?12,"CMR",?19,"Location",?41,"Using Service"
. W !,"---------",?12,"-----",?19,"--------------------"
. W ?41,"------------------------------"
Q
;
DISASGN(ENDA) ; Display Active Assignments for Equipment
; check page
; display assignment data
N ENADA,ENSTAT
S ENADA=0 F S ENADA=$O(^ENG(6916.3,"AEA",ENDA,ENADA)) Q:'ENADA D
. I $Y+4>IOSL D HD Q:END W !,"Entry #: ",ENDA," (continued)"
. W !," Assign: "
. W $$FMTE^XLFDT($$GET1^DIQ(6916.3,ENADA,2,"I"),"2DZ")
. W ?20,$$GET1^DIQ(6916.3,ENADA,1)
. S ENSTAT=$$GET1^DIQ(6916.3,ENADA,20)
. W ?52,"Status: ",ENSTAT
. I ENSTAT'="ASSIGNED" W ?71,$$GET1^DIQ(6916.3,ENADA,21)
Q
;
;ENTIRRE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENTIRRE 3479 printed Nov 22, 2024@17:06:02 Page 2
ENTIRRE ;WOIFO/SAB - IT Equipment Report ;2/4/2008
+1 ;;7.0;ENGINEERING;**87**;Aug 17, 1993;Build 16
+2 ;
+3 NEW ENIA,ENKTMP,ENSM,ENSMV,ENSRT,ENX
+4 ;
+5 ; ask equipment selection method
+6 SET ENX=$$ASKEQSM^ENTIUTL2("AECULS")
+7 SET ENSM=$PIECE(ENX,U)
SET ENSMV=$PIECE(ENX,U,2)
+8 if "^A^E^C^U^L^S^"'[(U_ENSM_U)
QUIT
+9 ;
+10 ; ask sort
+11 SET ENSRT=$$ASKEQSRT^ENTIUTL2(ENSM)
+12 ; user time-out or '^'
if ENSRT=""
QUIT
+13 ;
+14 ; include equipment with active assignments
SET ENIA=1
+15 ;
+16 ; if method is E then obtain list of equipment
+17 IF ENSM="E"
DO GETEQ^ENTIUTL2(ENSM,ENSMV,ENSRT,ENIA)
+18 ;
+19 ; flag to kill TMP global
SET ENKTMP=1
+20 ;
AEN ; entry point from ENTIRA routine (with it's list of equipment in ^TMP)
+1 NEW ENBFMT
+2 ;
+3 ; ask format
+4 SET DIR(0)="Y"
+5 SET DIR("A")="Do you want the brief display format"
+6 SET DIR("B")="YES"
+7 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+8 SET ENBFMT=Y
+9 ;
+10 ; ask device
+11 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
+12 IF $DATA(IO("Q"))
Begin DoDot:1
+13 NEW ENY
+14 SET ZTRTN="QEN^ENTIRRE"
SET ZTDESC="IT Equipment Report"
+15 FOR ENY="ENSM","ENSMV","ENIA","ENSRT","ENBFMT","ENKTMP"
SET ZTSAVE(ENY)=""
+16 SET ZTSAVE("^TMP($J,""ENITEQ"",")=""
+17 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK,IO("Q")
End DoDot:1
GOTO EXIT
+18 ;
QEN ; queued entry
+1 USE IO
+2 ;
+3 ; generate output
+4 KILL ENT
SET ENT=0
+5 SET (END,ENPG)=0
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET ENDT=Y
+6 ;
+7 ; build header line 2 string
+8 SET ENHL2=$$BLDHL2^ENTIUTL(ENSM,ENSMV,ENSRT)
+9 ;
+10 DO HD
+11 ;
+12 ; if sorted equipment list is not already built then build it
+13 IF '$DATA(^TMP($JOB,"ENITEQ"))
DO GETEQ^ENTIUTL2(ENSM,ENSMV,ENSRT,ENIA)
+14 ;
+15 ; print equipment
+16 ; loop thru sort value
+17 SET ENSRTV=""
+18 FOR
SET ENSRTV=$ORDER(^TMP($JOB,"ENITEQ",ENSRTV))
if ENSRTV=""
QUIT
Begin DoDot:1
+19 ; loop thru equipment
+20 SET ENDA=0
+21 FOR
SET ENDA=$ORDER(^TMP($JOB,"ENITEQ",ENSRTV,ENDA))
if 'ENDA
QUIT
Begin DoDot:2
+22 SET ENT=ENT+1
+23 ; display equipment data
+24 IF $Y+$SELECT(ENBFMT:5,1:8)>IOSL
DO HD
if END
QUIT
+25 IF ENBFMT
Begin DoDot:3
+26 SET ENCMR=$$GET1^DIQ(6914,ENDA,19)
+27 SET ENLOC=$$GET1^DIQ(6914,ENDA,24)
+28 SET ENSVC=$$GET1^DIQ(6914,ENDA,21)
+29 SET ENNAM=$$GET1^DIQ(6914,ENDA,3)
+30 WRITE !,ENDA,?12,ENCMR,?19,ENLOC,?41,ENSVC
+31 WRITE !,?2,$EXTRACT(ENNAM,1,78)
End DoDot:3
+32 IF '$TEST
DO CAPEQ^ENTIUTL(ENDA,"HD^ENTIRRE",,.END)
if END
QUIT
+33 ; display assignments
+34 DO DISASGN(ENDA)
+35 WRITE !
End DoDot:2
if END
QUIT
End DoDot:1
if END
QUIT
+36 ;
+37 IF 'END
Begin DoDot:1
+38 ; report footer
+39 IF $Y+4>IOSL
DO HD
if END
QUIT
+40 WRITE !!,"Count of IT equipment items on report = ",ENT
+41 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+42 ;
+43 DO ^%ZISC
+44 ;
EXIT IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 IF $GET(ENKTMP)
KILL ^TMP($JOB,"ENITEQ")
+2 KILL DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,POP,X,Y
+3 KILL ENCMR,ENDA,ENHL2,ENKTMP,ENLOC,ENNAM,ENNSP,ENSM,ENSMV
+4 KILL ENSRT,ENSRTV,ENSVC,ENT,END,ENDT,ENPG
+5 QUIT
+6 ;
HD ; header
+1 IF $EXTRACT(IOST,1,2)="C-"
IF ENPG
SET DIR(0)="E"
DO ^DIR
KILL DIR
IF 'Y
SET END=1
QUIT
+2 IF $EXTRACT(IOST,1,2)="C-"!ENPG
WRITE @IOF
+3 SET ENPG=ENPG+1
+4 WRITE "IT EQUIPMENT REPORT",?48,ENDT,?72,"page ",ENPG
+5 WRITE !,ENHL2,!
+6 IF ENBFMT
Begin DoDot:1
+7 WRITE !,"Entry #",?12,"CMR",?19,"Location",?41,"Using Service"
+8 WRITE !,"---------",?12,"-----",?19,"--------------------"
+9 WRITE ?41,"------------------------------"
End DoDot:1
+10 QUIT
+11 ;
DISASGN(ENDA) ; Display Active Assignments for Equipment
+1 ; check page
+2 ; display assignment data
+3 NEW ENADA,ENSTAT
+4 SET ENADA=0
FOR
SET ENADA=$ORDER(^ENG(6916.3,"AEA",ENDA,ENADA))
if 'ENADA
QUIT
Begin DoDot:1
+5 IF $Y+4>IOSL
DO HD
if END
QUIT
WRITE !,"Entry #: ",ENDA," (continued)"
+6 WRITE !," Assign: "
+7 WRITE $$FMTE^XLFDT($$GET1^DIQ(6916.3,ENADA,2,"I"),"2DZ")
+8 WRITE ?20,$$GET1^DIQ(6916.3,ENADA,1)
+9 SET ENSTAT=$$GET1^DIQ(6916.3,ENADA,20)
+10 WRITE ?52,"Status: ",ENSTAT
+11 IF ENSTAT'="ASSIGNED"
WRITE ?71,$$GET1^DIQ(6916.3,ENADA,21)
End DoDot:1
+12 QUIT
+13 ;
+14 ;ENTIRRE
