ENTIRRU ;WOIFO/SAB - Assignments Pending Acceptance 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^ENTIRRU",ZTDESC="Assignments Pending Acceptance 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,ENT("A")=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
K ^TMP($J,"ENITASGN")
; loop thru unsigned assignments by owner
S ENOWN=0 F S ENOWN=$O(^ENG(6916.3,"AOU",ENOWN)) Q:'ENOWN D
. S ENDA=0 F S ENDA=$O(^ENG(6916.3,"AOU",ENOWN,ENDA)) Q:'ENDA D
. . ; apply screen (if any) for selection method and value
. . I ENSM="C",$$GET1^DIQ(6916.3,ENDA,".01:19","I")'=ENSMV Q
. . I ENSM="U",$$GET1^DIQ(6916.3,ENDA,".01:21","I")'=ENSMV Q
. . I ENSM="L",$$GET1^DIQ(6916.3,ENDA,".01:24","I")'=ENSMV Q
. . I ENSM="S",$$GET1^DIQ(6916.3,ENDA,".01:24:1.5","I")'=ENSMV Q
. . ; passed all screens
. . ;
. . ; determine sort value
. . S ENSRTV=""
. . S ENEQ=$$GET1^DIQ(6916.3,ENDA,.01)
. . I ENSRT="E" S ENSRTV=ENEQ
. . I ENSRT="C" S ENSRTV=$$GET1^DIQ(6914,ENEQ,19) ; cmr
. . I ENSRT="U" S ENSRTV=$$GET1^DIQ(6914,ENEQ,21) ; servce
. . I ENSRT="L" S ENSRTV=$$GET1^DIQ(6914,ENEQ,24) ; location
. . I ENSRT="S" S ENSRTV=$$GET1^DIQ(6914,ENEQ,"24:1.5") ; svc of loc
. . I ENSRTV="" S ENSRTV=" <null>"
. . ;
. . ; save in tmp
. . S ^TMP($J,"ENITASGN",ENSRTV,ENEQ,ENDA)=""
;
; print equipment & unsigned assignments
; loop thru sort value
S ENSRTV=""
F S ENSRTV=$O(^TMP($J,"ENITASGN",ENSRTV)) Q:ENSRTV="" D Q:END
. ; loop thru equipment
. S ENEQ=0
. F S ENEQ=$O(^TMP($J,"ENITASGN",ENSRTV,ENEQ)) Q:'ENEQ 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,ENEQ,19)
. . . S ENLOC=$$GET1^DIQ(6914,ENEQ,24)
. . . S ENSVC=$$GET1^DIQ(6914,ENEQ,21)
. . . S ENNAM=$$GET1^DIQ(6914,ENEQ,3)
. . . W !,ENEQ,?12,ENCMR,?19,ENLOC,?41,ENSVC
. . . W !,?2,$E(ENNAM,1,78)
. . E D CAPEQ^ENTIUTL(ENEQ,"HD^ENTIRRU",,.END) Q:END
. . ;
. . ; loop thru unsigned assignments
. . S ENDA=0
. . F S ENDA=$O(^TMP($J,"ENITASGN",ENSRTV,ENEQ,ENDA)) Q:'ENDA D Q:END
. . . S ENT("A")=ENT("A")+1
. . . ; display assignment data
. . . I $Y+4>IOSL D HD Q:END W !,"Entry #: ",ENEQ," (continued)"
. . . W !," Assign: "
. . . W $$FMTE^XLFDT($$GET1^DIQ(6916.3,ENDA,2,"I"),"2DZ")
. . . W ?20,$$GET1^DIQ(6916.3,ENDA,1)
. . . S ENSTAT=$$GET1^DIQ(6916.3,ENDA,20)
. . . W ?52,"Status: ",ENSTAT
. . . I ENSTAT'="ASSIGNED" W ?71,$$GET1^DIQ(6916.3,ENDA,21)
. . W !
;
I 'END D
. ; report footer
. I $Y+4>IOSL D HD Q:END
. W !!,"Count of IT equipment items on report = ",ENT
. W !,"Count of unsigned assignments on report = ",ENT("A")
. 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,"ENITASGN")
K DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,POP,X,Y
K ENBFMT,ENCMR,ENDA,ENEQ,ENLOC,ENNAM,ENOWN,ENSM,ENSMV
K ENSRT,ENSRTV,ENSTAT,ENSVC,ENT,END,ENDT,ENHL2,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 "Assignments Pending Acceptance 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
;
;ENTIRRU
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HENTIRRU 4219 printed Nov 22, 2024@17:06:06 Page 2
ENTIRRU ;WOIFO/SAB - Assignments Pending Acceptance 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^ENTIRRU"
SET ZTDESC="Assignments Pending Acceptance 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
SET ENT("A")=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 KILL ^TMP($JOB,"ENITASGN")
+14 ; loop thru unsigned assignments by owner
+15 SET ENOWN=0
FOR
SET ENOWN=$ORDER(^ENG(6916.3,"AOU",ENOWN))
if 'ENOWN
QUIT
Begin DoDot:1
+16 SET ENDA=0
FOR
SET ENDA=$ORDER(^ENG(6916.3,"AOU",ENOWN,ENDA))
if 'ENDA
QUIT
Begin DoDot:2
+17 ; apply screen (if any) for selection method and value
+18 IF ENSM="C"
IF $$GET1^DIQ(6916.3,ENDA,".01:19","I")'=ENSMV
QUIT
+19 IF ENSM="U"
IF $$GET1^DIQ(6916.3,ENDA,".01:21","I")'=ENSMV
QUIT
+20 IF ENSM="L"
IF $$GET1^DIQ(6916.3,ENDA,".01:24","I")'=ENSMV
QUIT
+21 IF ENSM="S"
IF $$GET1^DIQ(6916.3,ENDA,".01:24:1.5","I")'=ENSMV
QUIT
+22 ; passed all screens
+23 ;
+24 ; determine sort value
+25 SET ENSRTV=""
+26 SET ENEQ=$$GET1^DIQ(6916.3,ENDA,.01)
+27 IF ENSRT="E"
SET ENSRTV=ENEQ
+28 ; cmr
IF ENSRT="C"
SET ENSRTV=$$GET1^DIQ(6914,ENEQ,19)
+29 ; servce
IF ENSRT="U"
SET ENSRTV=$$GET1^DIQ(6914,ENEQ,21)
+30 ; location
IF ENSRT="L"
SET ENSRTV=$$GET1^DIQ(6914,ENEQ,24)
+31 ; svc of loc
IF ENSRT="S"
SET ENSRTV=$$GET1^DIQ(6914,ENEQ,"24:1.5")
+32 IF ENSRTV=""
SET ENSRTV=" <null>"
+33 ;
+34 ; save in tmp
+35 SET ^TMP($JOB,"ENITASGN",ENSRTV,ENEQ,ENDA)=""
End DoDot:2
End DoDot:1
+36 ;
+37 ; print equipment & unsigned assignments
+38 ; loop thru sort value
+39 SET ENSRTV=""
+40 FOR
SET ENSRTV=$ORDER(^TMP($JOB,"ENITASGN",ENSRTV))
if ENSRTV=""
QUIT
Begin DoDot:1
+41 ; loop thru equipment
+42 SET ENEQ=0
+43 FOR
SET ENEQ=$ORDER(^TMP($JOB,"ENITASGN",ENSRTV,ENEQ))
if 'ENEQ
QUIT
Begin DoDot:2
+44 SET ENT=ENT+1
+45 ; display equipment data
+46 IF $Y+$SELECT(ENBFMT:5,1:8)>IOSL
DO HD
if END
QUIT
+47 IF ENBFMT
Begin DoDot:3
+48 SET ENCMR=$$GET1^DIQ(6914,ENEQ,19)
+49 SET ENLOC=$$GET1^DIQ(6914,ENEQ,24)
+50 SET ENSVC=$$GET1^DIQ(6914,ENEQ,21)
+51 SET ENNAM=$$GET1^DIQ(6914,ENEQ,3)
+52 WRITE !,ENEQ,?12,ENCMR,?19,ENLOC,?41,ENSVC
+53 WRITE !,?2,$EXTRACT(ENNAM,1,78)
End DoDot:3
+54 IF '$TEST
DO CAPEQ^ENTIUTL(ENEQ,"HD^ENTIRRU",,.END)
if END
QUIT
+55 ;
+56 ; loop thru unsigned assignments
+57 SET ENDA=0
+58 FOR
SET ENDA=$ORDER(^TMP($JOB,"ENITASGN",ENSRTV,ENEQ,ENDA))
if 'ENDA
QUIT
Begin DoDot:3
+59 SET ENT("A")=ENT("A")+1
+60 ; display assignment data
+61 IF $Y+4>IOSL
DO HD
if END
QUIT
WRITE !,"Entry #: ",ENEQ," (continued)"
+62 WRITE !," Assign: "
+63 WRITE $$FMTE^XLFDT($$GET1^DIQ(6916.3,ENDA,2,"I"),"2DZ")
+64 WRITE ?20,$$GET1^DIQ(6916.3,ENDA,1)
+65 SET ENSTAT=$$GET1^DIQ(6916.3,ENDA,20)
+66 WRITE ?52,"Status: ",ENSTAT
+67 IF ENSTAT'="ASSIGNED"
WRITE ?71,$$GET1^DIQ(6916.3,ENDA,21)
End DoDot:3
if END
QUIT
+68 WRITE !
End DoDot:2
if END
QUIT
End DoDot:1
if END
QUIT
+69 ;
+70 IF 'END
Begin DoDot:1
+71 ; report footer
+72 IF $Y+4>IOSL
DO HD
if END
QUIT
+73 WRITE !!,"Count of IT equipment items on report = ",ENT
+74 WRITE !,"Count of unsigned assignments on report = ",ENT("A")
+75 IF $EXTRACT(IOST,1,2)="C-"
SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+76 ;
+77 DO ^%ZISC
+78 ;
EXIT IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+1 KILL ^TMP($JOB,"ENITASGN")
+2 KILL DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,POP,X,Y
+3 KILL ENBFMT,ENCMR,ENDA,ENEQ,ENLOC,ENNAM,ENOWN,ENSM,ENSMV
+4 KILL ENSRT,ENSRTV,ENSTAT,ENSVC,ENT,END,ENDT,ENHL2,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 "Assignments Pending Acceptance 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 ;ENTIRRU
