source: WorldVistAEHR/trunk/r/ENGINEERING-EN/ENTIRA.m@ 1150

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

initial load of WorldVistAEHR
File size: 3.1 KB
Line 
1ENTIRA ;WOIFO/SAB - IT EQUIPMENT RESPONSIBILITY ASSIGN ;2/4/2008
2 ;;7.0;ENGINEERING;**87**;Aug 17, 1993;Build 16
3 ;
4 N ENC,ENDA,ENIA,ENPER,ENSM,ENSMV,ENSRT,ENX,ENY
5 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
6 ;
7GETEQ ; get equipment
8 W !!,"Selecting accountable IT equipment to be assigned..."
9 ; ask method of selection
10 S ENX=$$ASKEQSM^ENTIUTL2("ECULS","E")
11 S ENSM=$P(ENX,U),ENSMV=$P(ENX,U,2)
12 G:"^E^C^U^L^S^"'[(U_ENSM_U) EXIT
13 ;
14 ; ask if already assigned equipment should be included
15 I ENSM="E" S ENIA="1"
16 E S ENIA=$$ASKIAEQ^ENTIUTL2()
17 G:ENIA="" EXIT
18 ;
19 ; select equipment using method
20 S ENSRT="E" ; set sort method = E
21 D GETEQ^ENTIUTL2(ENSM,ENSMV,ENSRT,ENIA)
22 ;
23 ; display count of selected equipment
24 S ENY=$G(^TMP($J,"ENITEQ",0))
25 W !!,+ENY," equipment item(s) selected."
26 ;
27 I ENY'>0 D G:Y GETEQ G EXIT
28 . W !!
29 . S DIR(0)="Y"
30 . S DIR("A")="No equipment was selected. Do you want to try again"
31 . S DIR("B")="YES"
32 . D ^DIR K DIR
33 ;
34 ; ask if detailed report desired
35 S DIR(0)="Y"
36 S DIR("A")="Do you want to print a list of the equipment"
37 S DIR("B")="YES"
38 D ^DIR K DIR G:$D(DIRUT) EXIT
39 I Y D AEN^ENTIRRE
40 ;
41GETPE ; get people that will be assigned the equipment
42 W !!,"Selecting person(s) to be assigned responsibility..."
43 D SELPER
44 ;
45 ; display count of selected persons
46 S ENY=$G(^TMP($J,"ENITPE",0))
47 W !!,+ENY," person(s) selected."
48 I ENY'>0 D G:Y GETPE G EXIT
49 . W !!
50 . S DIR(0)="Y"
51 . S DIR("A")="No responsible person selected. Do you want to try again"
52 . S DIR("B")="YES"
53 . D ^DIR K DIR
54 ;
55 ; confirm
56 S DIR(0)="Y"
57 S DIR("A")="OK to create assignments"
58 S DIR("B")="YES"
59 D ^DIR K DIR G:'Y EXIT
60 ;
61 ; make assignments
62 K ENC
63 ; loop thru equipment list
64 S ENDA=0 F S ENDA=$O(^TMP($J,"ENITEQ","NA",ENDA)) Q:'ENDA D
65 . ; loop thru person list
66 . S ENPER=0 F S ENPER=$O(^TMP($J,"ENITPE",ENPER)) Q:'ENPER D
67 . . ; create assignment
68 . . S ENX=$$ASGN^ENTIUTL1(ENDA,ENPER)
69 . . I ENX S ENC(1)=$G(ENC(1))+1
70 . . I ENX=0 W !," Equipment # ",ENDA," is already assigned to ",$$GET1^DIQ(200,ENPER,.01) S ENC(0)=$G(ENC(0))+1
71 . . I ENX="E" W !," ERROR. Equipment ",ENDA," was not assigned to ",$$GET1^DIQ(200,ENPER,.01) S ENC("E")=$G(ENC("E"))+1
72 ;
73 ; display totals
74 W !!,+$G(ENC(1))," equipment assignment(s) created."
75 W:$G(ENC(0)) !,ENC(0)," equipment assignment(s) already in place."
76 W:$G(ENC("E")) !,ENC("E")," assignment(s) not created due to an error."
77 ;
78EXIT ;
79 K ^TMP($J,"ENITEQ"),^TMP($J,"ENITPE")
80 Q
81 ;
82SELPER ; Select Person(s)
83 ; output
84 ; ^TMP($J,"ENITPE",0)=count
85 ; ^TMP($J,"ENITPE",ien)="" list of persons by internal entry number
86 ;
87 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
88 N ENCNT,END,ENDA,ENNAME
89 S ENCNT=0,END=0
90 K ^TMP($J,"ENITPE")
91 ;
92 ; ask person in loop
93 F D Q:END
94 . S DIC="^VA(200,"
95 . S DIC(0)="AQEM"
96 . I ENCNT>0 S DIC("A")="Select Another NEW PERSON NAME: "
97 . W !
98 . D ^DIC K DIC I Y<1 S END=1 Q
99 . S ENDA=+Y
100 . S ENNAME=$P(Y,U,2)
101 . S DIR(0)="Y",DIR("A")="Assign responsibility to "_ENNAME
102 . D ^DIR I $D(DIRUT) S END=1 Q
103 . I 'Y Q
104 . ; user confirmed
105 . S ENCNT=ENCNT+1
106 . S ^TMP($J,"ENITPE",ENDA)=""
107 ;
108 ; set output header node
109 S ^TMP($J,"ENITPE",0)=ENCNT
110 ;
111 ;ENTIRA
Note: See TracBrowser for help on using the repository browser.