source: FOIAVistA/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECRUTL.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 5.5 KB
Line 
1ECRUTL ;ALB/ESD - Event Capture Report Utilities ;1 Aug 97
2 ;;2.0; EVENT CAPTURE ;**5**;8 May 96
3 ;
4ASKLOC() ; Ask report location(s) (institution)
5 ; Input: None
6 ; Output: 1 if successful - location(s) will be in array ECLOC
7 ; 0 if unsuccessful
8 ;
9 N DIRUT,DUOUT,ECN,ECNUM,ECX,Y
10 D LOCARRY
11 ;
12 ;- Only one location exists
13 I '$D(ECLOC(2)) G ASKLOCQ
14 ;
15 W !
16 S DIR(0)="YA",DIR("A")="Do you want to print this report for all locations? ",DIR("B")="YES",DIR("?")="Enter YES to choose all Event Capture locations or NO to select a specific location."
17 D ^DIR K DIR I $D(DIRUT) K ECLOC G ASKLOCQ
18 I +Y G ASKLOCQ
19 I 'Y D
20 . W @IOF,!,"Event Capture Locations:",!
21 . F ECX=0:0 S ECX=$O(ECLOC(ECX)) Q:'ECX W ECX_". ",$P(ECLOC(ECX),"^",2),!
22 . S ECNUM=$$SEL
23 . I ECNUM D
24 .. S ECLOC(1)=+$P(ECLOC(ECNUM),"^")_"^"_$P(ECLOC(ECNUM),"^",2)
25 .. F ECX=0:0 S ECX=$O(ECLOC(ECX)) Q:'ECX K:(ECX>1) ECLOC(ECX)
26 . I 'ECNUM K ECLOC
27ASKLOCQ Q $S('$D(ECLOC):0,1:1)
28 ;
29 ;
30LOCARRY ;-- Get location(s) from "LOC" xref of DMMS Units (#720) fld of
31 ; INSTITUTION file and create ECLOC array
32 ;
33 N ECLNAM,ECLNUM,ECCNT
34 S (ECCNT,ECLNUM)=0,ECLNAM=""
35 F S ECLNAM=$O(^DIC(4,"LOC",ECLNAM)) Q:ECLNAM="" F S ECLNUM=$O(^DIC(4,"LOC",ECLNAM,ECLNUM)) Q:'ECLNUM S ECCNT=ECCNT+1,ECLOC(ECCNT)=ECLNUM_"^"_ECLNAM
36 Q
37 ;
38 ;
39SEL() ;-- Select one location from ECLOC array
40 ;
41GETNUM N DIRUT,DUOUT,Y
42 S DIR(0)="NA",DIR("A")="Select Number: ",DIR("?")=$P($T(HLPTXT),";;",2)
43 D ^DIR K DIR
44 I $D(DIRUT) S ECN=0 G SELQ
45 I '$D(ECLOC(+Y)) W !!,$P($T(HLPTXT),";;",2) G GETNUM
46 S ECN=+Y
47SELQ Q +$G(ECN)
48 ;
49 ;
50 ;
51ASKDSS() ; Ask DSS Unit(s)
52 ; Input: None
53 ; Output: 1 if successful - DSS Units will be in array ECDSSU
54 ; 0 if unsuccessful
55 ;
56 N DIRUT,DUOUT,ECKEY,ECNT,ECD,ECN,ECX,I,Y
57 S ECKEY=$S($D(^XUSEC("ECALLU",DUZ)):1,1:0)
58 W ! S DIR(0)="YA"
59 S DIR("A")="Do you want to print this report for all "_$S('ECKEY:"accessible ",1:"")_"DSS Units? ",DIR("B")="YES"
60 D ^DIR K DIR
61 G:$D(DIRUT) ASKDSSQ
62 D @($S(+Y:"ALLU",1:"SPECU"))
63ASKDSSQ Q $S('$D(ECDSSU):0,1:1)
64 ;
65 ;
66ALLU ;-- Get all DSS Units and create ECDSSU array
67 N DIR,ECD,ECN,ECX,I,Y
68 S ECD="",(ECN,ECX)=0
69 F S ECD=$O(^ECD("B",ECD)) Q:ECD="" F S ECN=$O(^ECD("B",ECD,ECN)) Q:'ECN D
70 . Q:'$$VALID(ECN)!('ECKEY&('$D(^VA(200,DUZ,"EC",+ECN))))
71 . S ECX=ECX+1,ECDSSU(ECX)=ECN_"^"_ECD
72 I '$D(ECDSSU) D
73 . W !!,$P($T(NOUNITS),";;",2),!
74 . F I=0:1:1 W !,$P($T(ERRMSG+I),";;",2)
75 . W ! S DIR(0)="E" D ^DIR
76ALLUQ Q
77 ;
78 ;
79SPECU ;-- Get specific DSS Units
80 N DIRUT,DUOUT,Y
81 W !
82 S DIR(0)="YA",DIR("A")="Do you want to print this report for specific DSS Unit(s)? ",DIR("B")="YES"
83 S DIR("?")="Enter YES to select specific DSS Unit(s) or NO to quit."
84 D ^DIR K DIR
85 I 'Y!($D(DIRUT)) G SPECUQ
86 D SELU
87SPECUQ Q
88 ;
89 ;
90SELU ;-- Create ECDSSU array containing DSS Units after checking for validity and access to Unit
91 N ECX,I,Y,Z
92 S (ECX,Z)=0
93GETU W ! K DUOUT,DTOUT,DIRUT,Y
94 S DIC=724,DIC("A")="Select DSS Unit: ",DIC(0)="QEAMZ"
95 S DIC("S")="I ECKEY!($D(^VA(200,DUZ,""EC"",+Y)))"
96 D ^DIC K DIC
97 G SELUQ:$D(DTOUT)!($D(DUOUT))
98 I +Y>0 D G GETU
99 . F I=1:1:ECX I +Y=+ECDSSU(I) D Q
100 .. W !,?10,"But you already selected that one... try again."
101 .. S Y=-1
102 . Q:Y=-1
103 . I $$VALID(+Y) S ECX=ECX+1,ECDSSU(ECX)=Y
104 . I '$$VALID(+Y) W ! F I=0:1:1 W !?5,$P($T(INVALID+I),";;",2)
105 I +Y<0 S Z=$$DISPU() I 'Z W !!?10," *** NO DSS UNITS SELECTED ***" G SELUQ
106 W ! S DIR(0)="YA",DIR("A")="Is this list correct? ",DIR("B")="YES",DIR("?")="Answer YES to accept the list, NO to start over."
107 D ^DIR K DIR
108 I $D(DIRUT) G SELUQ
109 I '$G(Y) S ECX=0 K ECDSSU G GETU
110SELUQ I $D(DIRUT)!($D(DTOUT))!($D(DUOUT)) D
111 . I $D(ECDSSU) W !!,?10,"Deleting selection...",!
112 . K ECDSSU
113 Q
114 ;
115 ;
116VALID(IEN) ;-- Check DSS Unit for use by Event Capture
117 N NODE
118 S NODE=$G(^ECD(IEN,0))
119 Q $S($P(NODE,"^",8):1,1:0)
120 ;
121 ;
122DISPU(TYP) ;-- Display DSS Units
123 N X
124 I '$D(ECDSSU) G DISPUQ
125 W @IOF,!!,$S($G(TYP)="All":TYP,1:"Selected")_" DSS Units:",!
126 F X=0:0 S X=$O(ECDSSU(X)) Q:'X W !?5,X_". ",$P(ECDSSU(X),"^",2)
127 W !
128DISPUQ Q $S($D(ECDSSU):1,1:0)
129 ;
130 ;
131HLPTXT ;; Enter the number corresponding to the location you want to select.
132NOUNITS ;; You do not have access to any DSS Units.
133ERRMSG ;; If you are responsible for printing this report, contact your Event
134 ;; Capture ADPAC to allow access.
135INVALID ;; This DSS Unit is either inactive or cannot be used with the
136 ;; Event Capture software. Please select another DSS Unit.
137 ;
138 ;
139 ;
140STDT() ; Get Start Date
141 ; Input: None
142 ; Output: 1 if successful - start date in ECSTDT
143 ; 0 if unsuccessful
144 ;
145EN N DIRUT,DUOUT,Y
146 W ! S DIR(0)="DA^::EX",DIR("A")="Enter Start Date: ",DIR("?")="^D HELP^%DTC"
147 D ^DIR K DIR G:$D(DIRUT) STDTQ
148 I (+Y>DT) W !,"*** Future dates are not allowed ***" G EN
149 S ECSTDT=+Y,ECSTDT=ECSTDT-.0001
150STDTQ Q $S($G(ECSTDT):1,1:0)
151 ;
152 ;
153 ;
154ENDDT(STDT) ; Get End Date
155 ; Input: STDT - Start Date
156 ; Output: 1 if successful - end date in ECENDDT
157 ; 0 if unsuccessful
158 ;
159 N DIRUT,DUOUT,Y
160 G:'$G(STDT) ENDDTQ
161 W ! S DIR(0)="DA^"_STDT_":DT:EX",DIR("A")="Enter End Date: "
162 S DIR("?")="^W ""*** Future dates are not allowed ***"",! D HELP^%DTC"
163 D ^DIR K DIR G:$D(DIRUT) ENDDTQ
164 S ECENDDT=+Y,ECENDDT=ECENDDT+.9999
165ENDDTQ Q $S($G(ECENDDT):1,1:0)
166 ;
167REASON ;* Prompt to report Procedure Reasons
168 ;
169 ;* Variables returned
170 ; ECRY - Must be KILLed by calling routine
171 ;
172 S DIR(0)="Y^A"
173 S DIR("A")="Do you want to include Procedure Reasons"
174 S DIR("B")="NO"
175 S DIR("?",1)="Enter Yes to include procedure reasons on the report."
176 S DIR("?")="Enter No to report without procedure reasons."
177 D ^DIR
178 S:(+Y=1) ECRY=""
179 K DIR,Y
180 Q
Note: See TracBrowser for help on using the repository browser.