source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENTIRRU.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.0 KB
Line 
1ENTIRRU ;WOIFO/SAB - Assignments Pending Acceptance Report ;2/4/2008
2 ;;7.0;ENGINEERING;**87**;Aug 17, 1993;Build 16
3 ;
4 N ENBFMT,ENSM,ENSMV,ENSRT,ENX,ENY
5 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
6 ;
7 ; ask equipment selection method
8 S ENX=$$ASKEQSM^ENTIUTL2("ACULS")
9 S ENSM=$P(ENX,U),ENSMV=$P(ENX,U,2)
10 Q:"^A^C^U^L^S^"'[(U_ENSM_U)
11 ;
12 ; ask sort
13 S ENSRT=$$ASKEQSRT^ENTIUTL2(ENSM)
14 Q:ENSRT="" ; user time-out or '^'
15 ;
16 ; ask format
17 S DIR(0)="Y"
18 S DIR("A")="Do you want the brief display format"
19 S DIR("B")="YES"
20 D ^DIR K DIR Q:$D(DIRUT)
21 S ENBFMT=Y
22 ;
23 ; ask device
24 S %ZIS="Q" D ^%ZIS G:POP EXIT
25 I $D(IO("Q")) D G EXIT
26 . S ZTRTN="QEN^ENTIRRU",ZTDESC="Assignments Pending Acceptance Report"
27 . F ENY="ENSM","ENSMV","ENSRT","ENBFMT" S ZTSAVE(ENY)=""
28 . D ^%ZTLOAD,HOME^%ZIS K ZTSK,IO("Q")
29 ;
30QEN ; queued entry
31 U IO
32 ;
33 ; generate output
34 K ENT S ENT=0,ENT("A")=0
35 S (END,ENPG)=0 D NOW^%DTC S Y=% D DD^%DT S ENDT=Y
36 ;
37 ; build header line 2 string
38 S ENHL2=$$BLDHL2^ENTIUTL(ENSM,ENSMV,ENSRT)
39 ;
40 D HD
41 ;
42 ; build sorted list of equipment
43 K ^TMP($J,"ENITASGN")
44 ; loop thru unsigned assignments by owner
45 S ENOWN=0 F S ENOWN=$O(^ENG(6916.3,"AOU",ENOWN)) Q:'ENOWN D
46 . S ENDA=0 F S ENDA=$O(^ENG(6916.3,"AOU",ENOWN,ENDA)) Q:'ENDA D
47 . . ; apply screen (if any) for selection method and value
48 . . I ENSM="C",$$GET1^DIQ(6916.3,ENDA,".01:19","I")'=ENSMV Q
49 . . I ENSM="U",$$GET1^DIQ(6916.3,ENDA,".01:21","I")'=ENSMV Q
50 . . I ENSM="L",$$GET1^DIQ(6916.3,ENDA,".01:24","I")'=ENSMV Q
51 . . I ENSM="S",$$GET1^DIQ(6916.3,ENDA,".01:24:1.5","I")'=ENSMV Q
52 . . ; passed all screens
53 . . ;
54 . . ; determine sort value
55 . . S ENSRTV=""
56 . . S ENEQ=$$GET1^DIQ(6916.3,ENDA,.01)
57 . . I ENSRT="E" S ENSRTV=ENEQ
58 . . I ENSRT="C" S ENSRTV=$$GET1^DIQ(6914,ENEQ,19) ; cmr
59 . . I ENSRT="U" S ENSRTV=$$GET1^DIQ(6914,ENEQ,21) ; servce
60 . . I ENSRT="L" S ENSRTV=$$GET1^DIQ(6914,ENEQ,24) ; location
61 . . I ENSRT="S" S ENSRTV=$$GET1^DIQ(6914,ENEQ,"24:1.5") ; svc of loc
62 . . I ENSRTV="" S ENSRTV=" <null>"
63 . . ;
64 . . ; save in tmp
65 . . S ^TMP($J,"ENITASGN",ENSRTV,ENEQ,ENDA)=""
66 ;
67 ; print equipment & unsigned assignments
68 ; loop thru sort value
69 S ENSRTV=""
70 F S ENSRTV=$O(^TMP($J,"ENITASGN",ENSRTV)) Q:ENSRTV="" D Q:END
71 . ; loop thru equipment
72 . S ENEQ=0
73 . F S ENEQ=$O(^TMP($J,"ENITASGN",ENSRTV,ENEQ)) Q:'ENEQ D Q:END
74 . . S ENT=ENT+1
75 . . ; display equipment data
76 . . I $Y+$S(ENBFMT:5,1:8)>IOSL D HD Q:END
77 . . I ENBFMT D
78 . . . S ENCMR=$$GET1^DIQ(6914,ENEQ,19)
79 . . . S ENLOC=$$GET1^DIQ(6914,ENEQ,24)
80 . . . S ENSVC=$$GET1^DIQ(6914,ENEQ,21)
81 . . . S ENNAM=$$GET1^DIQ(6914,ENEQ,3)
82 . . . W !,ENEQ,?12,ENCMR,?19,ENLOC,?41,ENSVC
83 . . . W !,?2,$E(ENNAM,1,78)
84 . . E D CAPEQ^ENTIUTL(ENEQ,"HD^ENTIRRU",,.END) Q:END
85 . . ;
86 . . ; loop thru unsigned assignments
87 . . S ENDA=0
88 . . F S ENDA=$O(^TMP($J,"ENITASGN",ENSRTV,ENEQ,ENDA)) Q:'ENDA D Q:END
89 . . . S ENT("A")=ENT("A")+1
90 . . . ; display assignment data
91 . . . I $Y+4>IOSL D HD Q:END W !,"Entry #: ",ENEQ," (continued)"
92 . . . W !," Assign: "
93 . . . W $$FMTE^XLFDT($$GET1^DIQ(6916.3,ENDA,2,"I"),"2DZ")
94 . . . W ?20,$$GET1^DIQ(6916.3,ENDA,1)
95 . . . S ENSTAT=$$GET1^DIQ(6916.3,ENDA,20)
96 . . . W ?52,"Status: ",ENSTAT
97 . . . I ENSTAT'="ASSIGNED" W ?71,$$GET1^DIQ(6916.3,ENDA,21)
98 . . W !
99 ;
100 I 'END D
101 . ; report footer
102 . I $Y+4>IOSL D HD Q:END
103 . W !!,"Count of IT equipment items on report = ",ENT
104 . W !,"Count of unsigned assignments on report = ",ENT("A")
105 . I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR K DIR
106 ;
107 D ^%ZISC
108 ;
109EXIT I $D(ZTQUEUED) S ZTREQ="@"
110 K ^TMP($J,"ENITASGN")
111 K DIR,DIROUT,DIRUT,DIWF,DIWL,DTOUT,DUOUT,POP,X,Y
112 K ENBFMT,ENCMR,ENDA,ENEQ,ENLOC,ENNAM,ENOWN,ENSM,ENSMV
113 K ENSRT,ENSRTV,ENSTAT,ENSVC,ENT,END,ENDT,ENHL2,ENPG
114 Q
115 ;
116HD ; header
117 I $E(IOST,1,2)="C-",ENPG S DIR(0)="E" D ^DIR K DIR I 'Y S END=1 Q
118 I $E(IOST,1,2)="C-"!ENPG W @IOF
119 S ENPG=ENPG+1
120 W "Assignments Pending Acceptance Report",?48,ENDT,?72,"page ",ENPG
121 W !,ENHL2,!
122 I ENBFMT D
123 . W !,"Entry #",?12,"CMR",?19,"Location",?41,"Using Service"
124 . W !,"---------",?12,"-----",?19,"--------------------"
125 . W ?41,"------------------------------"
126 Q
127 ;
128 ;ENTIRRU
Note: See TracBrowser for help on using the repository browser.