ENTINSR ;WOIFO/SAB - NON-SPACE FILE LOCATION REPORT ;2/4/2008
;;7.0;ENGINEERING;**87**;Aug 17, 1993;Build 16
;
; ask device
S %ZIS="Q" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="QEN^ENTINSR",ZTDESC="Non-Space File Location Report"
. 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
S ENL="",$P(ENL,"-",IOM)=""
D HD
;
; loop thru non-space file locations
S ENNSP="" F S ENNSP=$O(^ENG(6914,"ANSP",ENNSP)) Q:ENNSP="" D Q:END
. ; non-space file location
. I $Y+5>IOSL D HD Q:END
. W !!,"NON-SPACE FILE LOCATION: ",ENNSP
. ; loop thru equipment
. S ENDA=0 F S ENDA=$O(^ENG(6914,"ANSP",ENNSP,ENDA)) Q:'ENDA D Q:END
. . ; equipment item
. . I $Y+3>IOSL D HD Q:END D HDNSP
. . W !,?2,ENDA ; equip id
. . W ?14,$P($$GET1^DIQ(6914,ENDA_",",90.2),"@") ; non-space file date
. . W ?28,$$GET1^DIQ(6914,ENDA_",",90.1) ; non-space file person
. . W ?60,$$GET1^DIQ(6914,ENDA_",",24) ; location
. . S ENT=ENT+1
;
I 'END D
. ; report footer
. I $Y+4>IOSL D HD Q:END
. W !!,"Count of equipment items with non-space location values = ",ENT
. I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
;
D ^%ZISC
;
EXIT I $D(ZTQUEUED) S ZTREQ="@"
K DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,POP,X,Y
K ENDA,ENNSP,ENT
K END,ENDT,ENL,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 !,"NON-SPACE FILE LOCATION REPORT"
W ?48,ENDT,?72,"page ",ENPG
W !!,?2,"EQUIP ID #",?14,"NON-SP DATE",?28,"ENTERED BY",?60,"LOCATION"
W !,?2,$E(ENL,1,10),?14,$E(ENL,1,12),?28,$E(ENL,1,30),?60,$E(ENL,1,20)
Q
;
HDNSP ; header for continued NON-SPACE FILE LOCATION
I $G(ENNSP)]"" D
. W !,"NON-SPACE LOCATION: ",ENNSP," (continued)"
Q
;ENTINSR
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENTINSR 1903 printed Nov 22, 2024@17:05:57 Page 2
ENTINSR ;WOIFO/SAB - NON-SPACE FILE LOCATION REPORT ;2/4/2008
+1 ;;7.0;ENGINEERING;**87**;Aug 17, 1993;Build 16
+2 ;
+3 ; ask device
+4 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 SET ZTRTN="QEN^ENTINSR"
SET ZTDESC="Non-Space File Location Report"
+7 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK,IO("Q")
End DoDot:1
GOTO EXIT
+8 ;
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 SET ENL=""
SET $PIECE(ENL,"-",IOM)=""
+7 DO HD
+8 ;
+9 ; loop thru non-space file locations
+10 SET ENNSP=""
FOR
SET ENNSP=$ORDER(^ENG(6914,"ANSP",ENNSP))
if ENNSP=""
QUIT
Begin DoDot:1
+11 ; non-space file location
+12 IF $Y+5>IOSL
DO HD
if END
QUIT
+13 WRITE !!,"NON-SPACE FILE LOCATION: ",ENNSP
+14 ; loop thru equipment
+15 SET ENDA=0
FOR
SET ENDA=$ORDER(^ENG(6914,"ANSP",ENNSP,ENDA))
if 'ENDA
QUIT
Begin DoDot:2
+16 ; equipment item
+17 IF $Y+3>IOSL
DO HD
if END
QUIT
DO HDNSP
+18 ; equip id
WRITE !,?2,ENDA
+19 ; non-space file date
WRITE ?14,$PIECE($$GET1^DIQ(6914,ENDA_",",90.2),"@")
+20 ; non-space file person
WRITE ?28,$$GET1^DIQ(6914,ENDA_",",90.1)
+21 ; location
WRITE ?60,$$GET1^DIQ(6914,ENDA_",",24)
+22 SET ENT=ENT+1
End DoDot:2
if END
QUIT
End DoDot:1
if END
QUIT
+23 ;
+24 IF 'END
Begin DoDot:1
+25 ; report footer
+26 IF $Y+4>IOSL
DO HD
if END
QUIT
+27 WRITE !!,"Count of equipment items with non-space location values = ",ENT
+28 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+29 ;
+30 DO ^%ZISC
+31 ;
EXIT IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 KILL DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,POP,X,Y
+2 KILL ENDA,ENNSP,ENT
+3 KILL END,ENDT,ENL,ENPG
+4 QUIT
+5 ;
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 !,"NON-SPACE FILE LOCATION REPORT"
+5 WRITE ?48,ENDT,?72,"page ",ENPG
+6 WRITE !!,?2,"EQUIP ID #",?14,"NON-SP DATE",?28,"ENTERED BY",?60,"LOCATION"
+7 WRITE !,?2,$EXTRACT(ENL,1,10),?14,$EXTRACT(ENL,1,12),?28,$EXTRACT(ENL,1,30),?60,$EXTRACT(ENL,1,20)
+8 QUIT
+9 ;
HDNSP ; header for continued NON-SPACE FILE LOCATION
+1 IF $GET(ENNSP)]""
Begin DoDot:1
+2 WRITE !,"NON-SPACE LOCATION: ",ENNSP," (continued)"
End DoDot:1
+3 QUIT
+4 ;ENTINSR
