| 1 | ECSCR ;BIR/MAM,TTH,JPW-Retrieve Event Capture Location ;1 May 96 | 
|---|
| 2 | ;;2.0; EVENT CAPTURE ;**1,63,72**;8 May 96 | 
|---|
| 3 | S (ECOUT,X,CNT)=0 F I=0:0 S X=$O(^DIC(4,"LOC",X)) Q:X=""  S CNT=CNT+1,LOC(CNT)=X S Y=$O(^DIC(4,"LOC",X,0)),LOC(CNT)=LOC(CNT)_"^"_Y | 
|---|
| 4 | ;If the LOC array contains only one location, set the LOC1 array. | 
|---|
| 5 | I '$D(LOC(2)) S ECL=$P(LOC(1),"^",2),ECLOC=1,LOC1(1)=LOC(1) Q | 
|---|
| 6 | I $D(LOC(2)),$D(ECN),$D(ECY) W @IOF,!!,"Choose Event Capture Location for this event code screen.",! K ECY,ECN D LOC G END | 
|---|
| 7 | I $D(LOC(2)) D LL I '$D(ECL) Q | 
|---|
| 8 | END ;Exit routine | 
|---|
| 9 | Q | 
|---|
| 10 | LL ; select location | 
|---|
| 11 | S ECLOC=0,ECWORD="create^selectable^select a" | 
|---|
| 12 | W !!,"Do you want to "_$P(ECWORD,"^")_" this Event Code Screen for ALL locations ? YES//  " R X:DTIME Q:'$T!(X="^")  S:X="" X="Y" S X=$E(X) I "Yy"[X S ECL="ALL" Q | 
|---|
| 13 | S ECLOC=1 ;Specific location. | 
|---|
| 14 | I "YyNn"'[X W !!,"Enter <RET> if this procedure will be "_$P(ECWORD,"^",2)_" from all locations,",!,"or ""NO"" to "_$P(ECWORD,"^",3)_" location.",!! G LL | 
|---|
| 15 | W @IOF,!,"Event Capture Locations:  ",! | 
|---|
| 16 | LOC S CNT=0 F I=0:0 S CNT=$O(LOC(CNT)) Q:'CNT  W !,CNT_". "_$P(LOC(CNT),"^") | 
|---|
| 17 | ASK W !!,"Select Location: " R X:DTIME Q:'$T!("^"[X)  I '$D(LOC(X)) W !!,"Enter the number corresponding to the location you want to select.",! G ASK | 
|---|
| 18 | I X="" Q | 
|---|
| 19 | I $D(LOC1(X)) W !,"This location has already been selected." G ASK | 
|---|
| 20 | W "  "_$P(LOC(X),"^") S NUM=X,LOC1(NUM)=LOC(X) S ECL="ALL" | 
|---|
| 21 | G ASK | 
|---|
| 22 | Q | 
|---|
| 23 | ASK2 ;Display selection to the user. | 
|---|
| 24 | W !,"Event Code Screen Information:" | 
|---|
| 25 | W !,"----------------------------",! | 
|---|
| 26 | W !,"DSS Unit : "_ECDN,!,"Category : "_ECCN,!,"Procedure: "_$$NAM^ECSCR | 
|---|
| 27 | K Y,DIRUT | 
|---|
| 28 | W ! S DIR(0)="Y",DIR("B")="YES",DIR("A")="Is this information correct" | 
|---|
| 29 | D ^DIR Q:$D(DIRUT)  S ECANS=+Y | 
|---|
| 30 | Q | 
|---|
| 31 | NAM() ;Display procedure name. | 
|---|
| 32 | I ECP'?1.N.";".E Q "UNKNOWN" | 
|---|
| 33 | N ECPF,ECPC | 
|---|
| 34 | S ECPF="^"_$P(ECP,";",2) | 
|---|
| 35 | S ECPC=$S($E($P(ECP,";",2),1)="E":1,1:3) | 
|---|
| 36 | S ECPN=$S(ECPC=1:$P(@(ECPF_+ECP_",0)"),U,ECPC),1:$P($$CPT^ICPTCOD(+ECP),U,ECPC)) | 
|---|
| 37 | Q ECPN | 
|---|