ENTIRRI ;WOIFO/SAB - Individual Responsibility Report ;2/4/2008
;;7.0;ENGINEERING;**87**;Aug 17, 1993;Build 16
;
; if routine is called from the IT menu, variable ENITMENU is defined
;
N ENOWN
;
; determine IT owner to report
S ENOWN=""
I $D(ENITMENU) D Q:ENOWN=""
. ; ask person
. S DIC="^VA(200,"
. S DIC(0)="AQEM"
. S DIC("S")="I $D(^ENG(6916.3,""C"",Y))" ; screen on assignment owner
. D ^DIC K DIC
. I Y>0 S ENOWN=+Y
E S ENOWN=DUZ
;
; ask about ended assignments
S DIR(0)="Y"
S DIR("A")="Include ended assignments"
S DIR("B")="NO"
S DIR("?",1)="The report shows information on all active assignments"
S DIR("?",2)="of responsibility for the individual."
S DIR("?",3)="Enter YES at this prompt to also include information"
S DIR("?",4)="on assignments that have ended."
S DIR("?",5)=" "
S DIR("?")="Enter either 'Y' or 'N'."
D ^DIR K DIR G:$D(DIRUT) EXIT
S ENIEA=Y
;
; ask device
S %ZIS="Q" D ^%ZIS G:POP EXIT
I $D(IO("Q")) D G EXIT
. S ZTRTN="QEN^ENTIRRI",ZTDESC="Individual Responsibility Report"
. S ZTSAVE("ENOWN")="",ZTSAVE("ENIEA")=""
. 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 ENOWNE=$$GET1^DIQ(200,ENOWN,.01)
D HD
;
; gather and sort data
; loop thru assignments for owner
S ENDA=0 F S ENDA=$O(^ENG(6916.3,"C",ENOWN,ENDA)) Q:'ENDA D
. S ENY=$G(^ENG(6916.3,ENDA,0))
. I 'ENIEA,$P(ENY,U,8)]"" Q ; didn't chose to include ended assignment
. S ENEQ=$P(ENY,U) ; equipment ien
. S ENLOC=$$GET1^DIQ(6914,ENEQ,24) ; equipment location
. I ENLOC="" S ENLOC=" "
. S ^TMP($J,"ENIT",ENLOC,ENEQ,ENDA)=""
;
; print data
; loop thru locations
S ENLOC="" F S ENLOC=$O(^TMP($J,"ENIT",ENLOC)) Q:ENLOC="" D Q:END
. ; loop thru equipment
. S ENEQ=0
. F S ENEQ=$O(^TMP($J,"ENIT",ENLOC,ENEQ)) Q:'ENEQ D Q:END
. . ; display equipment data
. . I $Y+7>IOSL D HD Q:END
. . D CAPEQ^ENTIUTL(ENEQ,"HD^ENTIRRI",1,.END) Q:END
. . S ENT=ENT+1
. . ; loop thru assignments
. . S ENDA=0
. . F S ENDA=$O(^TMP($J,"ENIT",ENLOC,ENEQ,ENDA)) Q:'ENDA D Q:END
. . . ; display assignment data
. . . I $Y+3>IOSL D HD Q:END W !,"Entry #: ",ENEQ," (continued)"
. . . W !,?2,"Assign Date: ",$P($$GET1^DIQ(6916.3,ENDA,2),"@")
. . . W ?29,"Status: ",$$GET1^DIQ(6916.3,ENDA,20)
. . . W ?47,"Status Date: ",$$GET1^DIQ(6916.3,ENDA,21)
;
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,"ENIT")
K DIR,DIROUT,DIRUT,DTOUT,DUOUT,POP,X,Y
K ENDA,ENEQ,ENIEA,ENLOC,ENOWN,ENOWNE,ENT,ENY
K 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 "INDIVIDUAL RESPONSIBILITY REPORT",?48,ENDT,?72,"page ",ENPG,!
W " for ",ENOWNE," sorted by location"
I ENIEA W " (including ended assignments)"
W !
Q
;
;ENTIRRI
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENTIRRI 3129 printed Dec 13, 2024@01:55:56 Page 2
ENTIRRI ;WOIFO/SAB - Individual Responsibility Report ;2/4/2008
+1 ;;7.0;ENGINEERING;**87**;Aug 17, 1993;Build 16
+2 ;
+3 ; if routine is called from the IT menu, variable ENITMENU is defined
+4 ;
+5 NEW ENOWN
+6 ;
+7 ; determine IT owner to report
+8 SET ENOWN=""
+9 IF $DATA(ENITMENU)
Begin DoDot:1
+10 ; ask person
+11 SET DIC="^VA(200,"
+12 SET DIC(0)="AQEM"
+13 ; screen on assignment owner
SET DIC("S")="I $D(^ENG(6916.3,""C"",Y))"
+14 DO ^DIC
KILL DIC
+15 IF Y>0
SET ENOWN=+Y
End DoDot:1
if ENOWN=""
QUIT
+16 IF '$TEST
SET ENOWN=DUZ
+17 ;
+18 ; ask about ended assignments
+19 SET DIR(0)="Y"
+20 SET DIR("A")="Include ended assignments"
+21 SET DIR("B")="NO"
+22 SET DIR("?",1)="The report shows information on all active assignments"
+23 SET DIR("?",2)="of responsibility for the individual."
+24 SET DIR("?",3)="Enter YES at this prompt to also include information"
+25 SET DIR("?",4)="on assignments that have ended."
+26 SET DIR("?",5)=" "
+27 SET DIR("?")="Enter either 'Y' or 'N'."
+28 DO ^DIR
KILL DIR
if $DATA(DIRUT)
GOTO EXIT
+29 SET ENIEA=Y
+30 ;
+31 ; ask device
+32 SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO EXIT
+33 IF $DATA(IO("Q"))
Begin DoDot:1
+34 SET ZTRTN="QEN^ENTIRRI"
SET ZTDESC="Individual Responsibility Report"
+35 SET ZTSAVE("ENOWN")=""
SET ZTSAVE("ENIEA")=""
+36 DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK,IO("Q")
End DoDot:1
GOTO EXIT
+37 ;
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 ENOWNE=$$GET1^DIQ(200,ENOWN,.01)
+7 DO HD
+8 ;
+9 ; gather and sort data
+10 ; loop thru assignments for owner
+11 SET ENDA=0
FOR
SET ENDA=$ORDER(^ENG(6916.3,"C",ENOWN,ENDA))
if 'ENDA
QUIT
Begin DoDot:1
+12 SET ENY=$GET(^ENG(6916.3,ENDA,0))
+13 ; didn't chose to include ended assignment
IF 'ENIEA
IF $PIECE(ENY,U,8)]""
QUIT
+14 ; equipment ien
SET ENEQ=$PIECE(ENY,U)
+15 ; equipment location
SET ENLOC=$$GET1^DIQ(6914,ENEQ,24)
+16 IF ENLOC=""
SET ENLOC=" "
+17 SET ^TMP($JOB,"ENIT",ENLOC,ENEQ,ENDA)=""
End DoDot:1
+18 ;
+19 ; print data
+20 ; loop thru locations
+21 SET ENLOC=""
FOR
SET ENLOC=$ORDER(^TMP($JOB,"ENIT",ENLOC))
if ENLOC=""
QUIT
Begin DoDot:1
+22 ; loop thru equipment
+23 SET ENEQ=0
+24 FOR
SET ENEQ=$ORDER(^TMP($JOB,"ENIT",ENLOC,ENEQ))
if 'ENEQ
QUIT
Begin DoDot:2
+25 ; display equipment data
+26 IF $Y+7>IOSL
DO HD
if END
QUIT
+27 DO CAPEQ^ENTIUTL(ENEQ,"HD^ENTIRRI",1,.END)
if END
QUIT
+28 SET ENT=ENT+1
+29 ; loop thru assignments
+30 SET ENDA=0
+31 FOR
SET ENDA=$ORDER(^TMP($JOB,"ENIT",ENLOC,ENEQ,ENDA))
if 'ENDA
QUIT
Begin DoDot:3
+32 ; display assignment data
+33 IF $Y+3>IOSL
DO HD
if END
QUIT
WRITE !,"Entry #: ",ENEQ," (continued)"
+34 WRITE !,?2,"Assign Date: ",$PIECE($$GET1^DIQ(6916.3,ENDA,2),"@")
+35 WRITE ?29,"Status: ",$$GET1^DIQ(6916.3,ENDA,20)
+36 WRITE ?47,"Status Date: ",$$GET1^DIQ(6916.3,ENDA,21)
End DoDot:3
if END
QUIT
End DoDot:2
if END
QUIT
End DoDot:1
if END
QUIT
+37 ;
+38 IF 'END
Begin DoDot:1
+39 ; report footer
+40 IF $Y+4>IOSL
DO HD
if END
QUIT
+41 WRITE !!,"Count of IT equipment items on report = ",ENT
+42 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+43 ;
+44 DO ^%ZISC
+45 ;
EXIT IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 KILL ^TMP($JOB,"ENIT")
+2 KILL DIR,DIROUT,DIRUT,DTOUT,DUOUT,POP,X,Y
+3 KILL ENDA,ENEQ,ENIEA,ENLOC,ENOWN,ENOWNE,ENT,ENY
+4 KILL 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 "INDIVIDUAL RESPONSIBILITY REPORT",?48,ENDT,?72,"page ",ENPG,!
+5 WRITE " for ",ENOWNE," sorted by location"
+6 IF ENIEA
WRITE " (including ended assignments)"
+7 WRITE !
+8 QUIT
+9 ;
+10 ;ENTIRRI
