ENTIRRNA ;WOIFO/SAB - IT Equipment Not Assigned Report ;2/4/2008
;;7.0;ENGINEERING;**87**;Aug 17, 1993;Build 16
;
N ENBFMT,ENSM,ENSMV,ENSRT,ENX,ENY
N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
;
; ask equipment selection method
S ENX=$$ASKEQSM^ENTIUTL2("ACULS")
S ENSM=$P(ENX,U),ENSMV=$P(ENX,U,2)
Q:"^A^C^U^L^S^"'[(U_ENSM_U)
;
; ask sort
S ENSRT=$$ASKEQSRT^ENTIUTL2(ENSM)
Q:ENSRT="" ; user time-out or '^'
;
; ask format
S DIR(0)="Y"
S DIR("A")="Do you want the brief display format"
S DIR("B")="YES"
D ^DIR K DIR Q:$D(DIRUT)
S ENBFMT=Y
;
; ask device
S %ZIS="Q" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="QEN^ENTIRRNA",ZTDESC="IT Equipment Not Assigned Report"
. F ENY="ENSM","ENSMV","ENSRT","ENBFMT" S ZTSAVE(ENY)=""
. 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
;
; build sorted list of equipment
D GETEQ^ENTIUTL2(ENSM,ENSMV,ENSRT,0)
;
; 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^ENTIRRNA",,.END) Q:END
. . 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="@"
K ^TMP($J,"ENITEQ")
K DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,POP,X,Y
K ENBFMT,ENCMR,ENDA,ENHL2,ENLOC,ENNAM,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 NOT ASSIGNED 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
;
;ENTIRRNA
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENTIRRNA 2557 printed Dec 13, 2024@01:55:57 Page 2
ENTIRRNA ;WOIFO/SAB - IT Equipment Not Assigned Report ;2/4/2008
+1 ;;7.0;ENGINEERING;**87**;Aug 17, 1993;Build 16
+2 ;
+3 NEW ENBFMT,ENSM,ENSMV,ENSRT,ENX,ENY
+4 NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+5 ;
+6 ; ask equipment selection method
+7 SET ENX=$$ASKEQSM^ENTIUTL2("ACULS")
+8 SET ENSM=$PIECE(ENX,U)
SET ENSMV=$PIECE(ENX,U,2)
+9 if "^A^C^U^L^S^"'[(U_ENSM_U)
QUIT
+10 ;
+11 ; ask sort
+12 SET ENSRT=$$ASKEQSRT^ENTIUTL2(ENSM)
+13 ; user time-out or '^'
if ENSRT=""
QUIT
+14 ;
+15 ; ask format
+16 SET DIR(0)="Y"
+17 SET DIR("A")="Do you want the brief display format"
+18 SET DIR("B")="YES"
+19 DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+20 SET ENBFMT=Y
+21 ;
+22 ; ask device
+23 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
+24 IF $DATA(IO("Q"))
Begin DoDot:1
+25 SET ZTRTN="QEN^ENTIRRNA"
SET ZTDESC="IT Equipment Not Assigned Report"
+26 FOR ENY="ENSM","ENSMV","ENSRT","ENBFMT"
SET ZTSAVE(ENY)=""
+27 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK,IO("Q")
End DoDot:1
GOTO EXIT
+28 ;
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 ; build sorted list of equipment
+13 DO GETEQ^ENTIUTL2(ENSM,ENSMV,ENSRT,0)
+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^ENTIRRNA",,.END)
if END
QUIT
+33 WRITE !
End DoDot:2
if END
QUIT
End DoDot:1
if END
QUIT
+34 ;
+35 IF 'END
Begin DoDot:1
+36 ; report footer
+37 IF $Y+4>IOSL
DO HD
if END
QUIT
+38 WRITE !!,"Count of IT equipment items on report = ",ENT
+39 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+40 ;
+41 DO ^%ZISC
+42 ;
EXIT IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 KILL ^TMP($JOB,"ENITEQ")
+2 KILL DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,POP,X,Y
+3 KILL ENBFMT,ENCMR,ENDA,ENHL2,ENLOC,ENNAM,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 NOT ASSIGNED 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 ;
+12 ;ENTIRRNA