ENARL ;(WIRMFO)/JED/SAB-ARCHIVE ACTIVITY LOG ;2.19.97
;;7.0;ENGINEERING;**40**;Aug 17, 1993
;CALLED BY ENAR
Q
L ; entry point
; ask log entry
S DIC="^ENG(6919,",DIC(0)="AEQM"
D ^DIC G:Y<0 EXIT S ENDA=+Y
L1 ; entry point with ENDA already defined
; if equipment archive then ask if equipment should also be listed
S ENEQL=0 I $P($G(^ENG(6919,ENDA,1)),U)=3 D G:$D(DIRUT) EXIT
. S DIR(0)="Y",DIR("A")="Should archived equipment Entry #s be listed"
. S DIR("B")="NO"
. D ^DIR K DIR S ENEQL=Y
; ask device
D DEV^ENLIB G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="PRNT^ENARL",ZTDESC="Engineering Archive Activity Log"
. S ZTSAVE("ENDA")="",ZTSAVE("ENEQL")=""
. D ^%ZTLOAD,HOME^%ZIS K ZTSK
PRNT ; queued entry point
S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDTR=Y
K ENDL S $P(ENDL,"-",80)=""
S ENDAN=$P($G(^ENG(6919,ENDA,0)),U)
D HD
; print archive log
S ENY=$G(^ENG(6919,ENDA,1))
W !,"RECORDS TYPE: ",$$EXTERNAL^DILFD(6919,1,"",$P(ENY,U))
W ?40,"FILE VERSION: ",$P(ENY,U,8)
W !,"START DATE: ",$$FMTE^XLFDT($P(ENY,U,2))
W ?40,"STOP DATE: ",$$FMTE^XLFDT($P(ENY,U,3))
W !,"OPT PARAMETERS: ",$P(ENY,U,4)
W !,"RECORDS SAVED: ",$P(ENY,U,5)
W ?25,"PHYSICAL LOCATION: ",$P(ENY,U,6)
W !,"TAPE DESCRIPTION: ",$P(ENY,U,7)
; print activity list
D HDA
I '$O(^ENG(6919,ENDA,2,0)) W !!,"There is no activity recorded"
E S ENI=0 F S ENI=$O(^ENG(6919,ENDA,2,ENI)) Q:'ENI D Q:END
. I $Y+4>IOSL D HD Q:END D HDA
. S ENX=$G(^ENG(6919,ENDA,2,ENI,0))
. S ENX(1)=$$FMTE^XLFDT($P(ENX,U))
. S ENX(2)=$$EXTERNAL^DILFD(6919.01,1,"",$P(ENX,U,2))
. W !,?5,$P(ENX(1),"@")," ",$P(ENX(1),"@",2),?28,ENX(2),?50,$P(ENX,U,3)
; print equipment list
I 'END,ENEQL D
. I $Y+8>IOSL D HD Q:END
. D HDE S ENX=""
. I '$O(^ENG(6919,ENDA,3,0)) W !!,"There is no archived equipment"
. E S ENI=0 F S ENI=$O(^ENG(6919,ENDA,3,ENI)) Q:'ENI D Q:END
. . I $Y+4>IOSL D HD Q:END D HDE
. . S ENEQ=$P($G(^ENG(6919,ENDA,3,ENI,0)),U)
. . I $L(ENX)+$L(ENEQ)+11>IOM W !,?5,ENX_"," S ENX=ENEQ
. . E S ENX=ENX_$S(ENX]"":", ",1:"")_ENEQ
. I 'END,ENX]"" W !,?5,ENX
I 'END,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
I $D(ZTQUEUED) S ZTREQ="@"
D ^%ZISC
EXIT ;
K DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
K END,ENDA,ENDAN,ENDL,ENDTR,ENEQ,ENEQL,ENI,ENPG,ENX,ENY
Q
;
HD ; page 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 !,"Archive Log Report ",?49,ENDTR,?72,"page ",ENPG
W !,"ARCHIVE ID: ",ENDAN
Q
HDA ; activity list header
W !!,ENDL
W !?5,"ACTIVITY DATE",?28,"ACTIVITY TYPE",?50,"REQUESTOR"
W !,ENDL
Q
HDE ; equipment list header
W !!,ENDL
W !,?5,"ARCHIVED EQUIPMENT LIST"
W !,ENDL
Q
;ENARL
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENARL 2764 printed Dec 13, 2024@01:51:39 Page 2
ENARL ;(WIRMFO)/JED/SAB-ARCHIVE ACTIVITY LOG ;2.19.97
+1 ;;7.0;ENGINEERING;**40**;Aug 17, 1993
+2 ;CALLED BY ENAR
+3 QUIT
L ; entry point
+1 ; ask log entry
+2 SET DIC="^ENG(6919,"
SET DIC(0)="AEQM"
+3 DO ^DIC
if Y<0
GOTO EXIT
SET ENDA=+Y
L1 ; entry point with ENDA already defined
+1 ; if equipment archive then ask if equipment should also be listed
+2 SET ENEQL=0
IF $PIECE($GET(^ENG(6919,ENDA,1)),U)=3
Begin DoDot:1
+3 SET DIR(0)="Y"
SET DIR("A")="Should archived equipment Entry #s be listed"
+4 SET DIR("B")="NO"
+5 DO ^DIR
KILL DIR
SET ENEQL=Y
End DoDot:1
if $DATA(DIRUT)
GOTO EXIT
+6 ; ask device
+7 DO DEV^ENLIB
if POP
GOTO EXIT
+8 IF $DATA(IO("Q"))
Begin DoDot:1
+9 SET ZTRTN="PRNT^ENARL"
SET ZTDESC="Engineering Archive Activity Log"
+10 SET ZTSAVE("ENDA")=""
SET ZTSAVE("ENEQL")=""
+11 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
PRNT ; queued entry point
+1 SET (END,ENPG)=0
DO NOW^%DTC
SET Y=%
DO DD^%DT
SET ENDTR=Y
+2 KILL ENDL
SET $PIECE(ENDL,"-",80)=""
+3 SET ENDAN=$PIECE($GET(^ENG(6919,ENDA,0)),U)
+4 DO HD
+5 ; print archive log
+6 SET ENY=$GET(^ENG(6919,ENDA,1))
+7 WRITE !,"RECORDS TYPE: ",$$EXTERNAL^DILFD(6919,1,"",$PIECE(ENY,U))
+8 WRITE ?40,"FILE VERSION: ",$PIECE(ENY,U,8)
+9 WRITE !,"START DATE: ",$$FMTE^XLFDT($PIECE(ENY,U,2))
+10 WRITE ?40,"STOP DATE: ",$$FMTE^XLFDT($PIECE(ENY,U,3))
+11 WRITE !,"OPT PARAMETERS: ",$PIECE(ENY,U,4)
+12 WRITE !,"RECORDS SAVED: ",$PIECE(ENY,U,5)
+13 WRITE ?25,"PHYSICAL LOCATION: ",$PIECE(ENY,U,6)
+14 WRITE !,"TAPE DESCRIPTION: ",$PIECE(ENY,U,7)
+15 ; print activity list
+16 DO HDA
+17 IF '$ORDER(^ENG(6919,ENDA,2,0))
WRITE !!,"There is no activity recorded"
+18 IF '$TEST
SET ENI=0
FOR
SET ENI=$ORDER(^ENG(6919,ENDA,2,ENI))
if 'ENI
QUIT
Begin DoDot:1
+19 IF $Y+4>IOSL
DO HD
if END
QUIT
DO HDA
+20 SET ENX=$GET(^ENG(6919,ENDA,2,ENI,0))
+21 SET ENX(1)=$$FMTE^XLFDT($PIECE(ENX,U))
+22 SET ENX(2)=$$EXTERNAL^DILFD(6919.01,1,"",$PIECE(ENX,U,2))
+23 WRITE !,?5,$PIECE(ENX(1),"@")," ",$PIECE(ENX(1),"@",2),?28,ENX(2),?50,$PIECE(ENX,U,3)
End DoDot:1
if END
QUIT
+24 ; print equipment list
+25 IF 'END
IF ENEQL
Begin DoDot:1
+26 IF $Y+8>IOSL
DO HD
if END
QUIT
+27 DO HDE
SET ENX=""
+28 IF '$ORDER(^ENG(6919,ENDA,3,0))
WRITE !!,"There is no archived equipment"
+29 IF '$TEST
SET ENI=0
FOR
SET ENI=$ORDER(^ENG(6919,ENDA,3,ENI))
if 'ENI
QUIT
Begin DoDot:2
+30 IF $Y+4>IOSL
DO HD
if END
QUIT
DO HDE
+31 SET ENEQ=$PIECE($GET(^ENG(6919,ENDA,3,ENI,0)),U)
+32 IF $LENGTH(ENX)+$LENGTH(ENEQ)+11>IOM
WRITE !,?5,ENX_","
SET ENX=ENEQ
+33 IF '$TEST
SET ENX=ENX_$SELECT(ENX]"":", ",1:"")_ENEQ
End DoDot:2
if END
QUIT
+34 IF 'END
IF ENX]""
WRITE !,?5,ENX
End DoDot:1
+35 IF 'END
IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
+36 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+37 DO ^%ZISC
EXIT ;
+1 KILL DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
+2 KILL END,ENDA,ENDAN,ENDL,ENDTR,ENEQ,ENEQL,ENI,ENPG,ENX,ENY
+3 QUIT
+4 ;
HD ; page 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 !,"Archive Log Report ",?49,ENDTR,?72,"page ",ENPG
+5 WRITE !,"ARCHIVE ID: ",ENDAN
+6 QUIT
HDA ; activity list header
+1 WRITE !!,ENDL
+2 WRITE !?5,"ACTIVITY DATE",?28,"ACTIVITY TYPE",?50,"REQUESTOR"
+3 WRITE !,ENDL
+4 QUIT
HDE ; equipment list header
+1 WRITE !!,ENDL
+2 WRITE !,?5,"ARCHIVED EQUIPMENT LIST"
+3 WRITE !,ENDL
+4 QUIT
+5 ;ENARL
