ECMFLOC ;ALB/JAM-Event Capture Management Location Filer ;16 Feb 01
;;2.0; EVENT CAPTURE ;**25**;8 May 96
;
FILE ;Used by the RPC broker to file local procedures in #4
; Variables passed in
; ECIEN - Location IEN
; ECST - Location Status
;
; Variable return
; ^TMP($J,"ECMSG",n)=Success or failure to file in #4^Message
;
N ECERR,ECNO
S ECERR=0 D CHKDT I ECERR Q
K DIC S DIC=4,DIC(0)="XN",X=ECIEN D ^DIC I Y<0 D Q
. S ^TMP($J,"ECMSG",1)="0^Location Not on File"
I ECST="C" D
. K DIE,DR S DIE=4,DR="720///1",DA=ECIEN D ^DIE
. S ^TMP($J,"ECMSG",1)="1^Location flagged for Event Capture"
I ECST="R" D
. S ECNO=0 I '$D(^DIC(4,ECIEN,"EC")) S ECNO=1
. I $D(^DIC(4,ECIEN,"EC")),+$P(^("EC"),"^")=0 S ECNO=1
. I ECNO S ^TMP($J,"ECMSG",1)="0^Not flagged as current location." Q
. K DIE,DR S DIE=4,DA=ECIEN,DR="720///@" D ^DIE
. S ^TMP($J,"ECMSG",1)="1^Location inactivated for Event Capture"
K DA,DR,DIE,DIC
Q
CHKDT ;Required Data Check
N I,C
S C=1
F I="ECIEN","ECST" D
.I $G(@I)="" S ^TMP($J,"ECMSG",C)="0^Key data missing "_I,C=C+1,ECERR=1
Q
;
HFS ;Used by the RPC broker to add/update or delete an entry in the
;PARAMETER file #8989.5
; Variables passed in
; ECDIV - Division IEN
; ECHFS - Directory/path
; ECOPER - Operation (add/update or delete)
;
; Variable return
; ^TMP($J,"ECMSG",n)=Success or failure to file in #8989.5^Message
;
N ECERR,ECPAR
S ECERR=0 D CHKDT1 I ECERR Q
K DIC S DIC=4,DIC(0)="XN",X=ECDIV D ^DIC I Y<0 D Q
. S ^TMP($J,"ECMSG",1)="0^Division Not on File"
I '$G(^DIC(4,ECDIV,"EC")) S ^TMP($J,"ECMSG",1)="0^Not an EC Division" Q
S ECDIV=ECDIV_";DIC(4,",ECPAR="EC HFS SCRATCH"
I ECOPER="A" D Q
. D EN^XPAR(ECDIV,ECPAR,,ECHFS,.ECERR)
. I '+ECERR S ^TMP($J,"ECMSG",1)="1^Directory successful added" Q
. S ^TMP($J,"ECMSG",1)="0^Error adding directory"
I ECOPER="D" D
. D NDEL^XPAR(ECDIV,ECPAR,.ECERR)
. I '+ECERR S ^TMP($J,"ECMSG",1)="1^Directory successful deleted" Q
. S ^TMP($J,"ECMSG",1)="0^Error deleting directory"
Q
CHKDT1 ;Required Data Check
N I,C
S C=1
F I="ECDIV","ECHFS","ECOPER" D
.I $G(@I)="" S ^TMP($J,"ECMSG",C)="0^Key data missing "_I,C=C+1,ECERR=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECMFLOC 2269 printed Apr 09, 2024@20:59:50 Page 2
ECMFLOC ;ALB/JAM-Event Capture Management Location Filer ;16 Feb 01
+1 ;;2.0; EVENT CAPTURE ;**25**;8 May 96
+2 ;
FILE ;Used by the RPC broker to file local procedures in #4
+1 ; Variables passed in
+2 ; ECIEN - Location IEN
+3 ; ECST - Location Status
+4 ;
+5 ; Variable return
+6 ; ^TMP($J,"ECMSG",n)=Success or failure to file in #4^Message
+7 ;
+8 NEW ECERR,ECNO
+9 SET ECERR=0
DO CHKDT
IF ECERR
QUIT
+10 KILL DIC
SET DIC=4
SET DIC(0)="XN"
SET X=ECIEN
DO ^DIC
IF Y<0
Begin DoDot:1
+11 SET ^TMP($JOB,"ECMSG",1)="0^Location Not on File"
End DoDot:1
QUIT
+12 IF ECST="C"
Begin DoDot:1
+13 KILL DIE,DR
SET DIE=4
SET DR="720///1"
SET DA=ECIEN
DO ^DIE
+14 SET ^TMP($JOB,"ECMSG",1)="1^Location flagged for Event Capture"
End DoDot:1
+15 IF ECST="R"
Begin DoDot:1
+16 SET ECNO=0
IF '$DATA(^DIC(4,ECIEN,"EC"))
SET ECNO=1
+17 IF $DATA(^DIC(4,ECIEN,"EC"))
IF +$PIECE(^("EC"),"^")=0
SET ECNO=1
+18 IF ECNO
SET ^TMP($JOB,"ECMSG",1)="0^Not flagged as current location."
QUIT
+19 KILL DIE,DR
SET DIE=4
SET DA=ECIEN
SET DR="720///@"
DO ^DIE
+20 SET ^TMP($JOB,"ECMSG",1)="1^Location inactivated for Event Capture"
End DoDot:1
+21 KILL DA,DR,DIE,DIC
+22 QUIT
CHKDT ;Required Data Check
+1 NEW I,C
+2 SET C=1
+3 FOR I="ECIEN","ECST"
Begin DoDot:1
+4 IF $GET(@I)=""
SET ^TMP($JOB,"ECMSG",C)="0^Key data missing "_I
SET C=C+1
SET ECERR=1
End DoDot:1
+5 QUIT
+6 ;
HFS ;Used by the RPC broker to add/update or delete an entry in the
+1 ;PARAMETER file #8989.5
+2 ; Variables passed in
+3 ; ECDIV - Division IEN
+4 ; ECHFS - Directory/path
+5 ; ECOPER - Operation (add/update or delete)
+6 ;
+7 ; Variable return
+8 ; ^TMP($J,"ECMSG",n)=Success or failure to file in #8989.5^Message
+9 ;
+10 NEW ECERR,ECPAR
+11 SET ECERR=0
DO CHKDT1
IF ECERR
QUIT
+12 KILL DIC
SET DIC=4
SET DIC(0)="XN"
SET X=ECDIV
DO ^DIC
IF Y<0
Begin DoDot:1
+13 SET ^TMP($JOB,"ECMSG",1)="0^Division Not on File"
End DoDot:1
QUIT
+14 IF '$GET(^DIC(4,ECDIV,"EC"))
SET ^TMP($JOB,"ECMSG",1)="0^Not an EC Division"
QUIT
+15 SET ECDIV=ECDIV_";DIC(4,"
SET ECPAR="EC HFS SCRATCH"
+16 IF ECOPER="A"
Begin DoDot:1
+17 DO EN^XPAR(ECDIV,ECPAR,,ECHFS,.ECERR)
+18 IF '+ECERR
SET ^TMP($JOB,"ECMSG",1)="1^Directory successful added"
QUIT
+19 SET ^TMP($JOB,"ECMSG",1)="0^Error adding directory"
End DoDot:1
QUIT
+20 IF ECOPER="D"
Begin DoDot:1
+21 DO NDEL^XPAR(ECDIV,ECPAR,.ECERR)
+22 IF '+ECERR
SET ^TMP($JOB,"ECMSG",1)="1^Directory successful deleted"
QUIT
+23 SET ^TMP($JOB,"ECMSG",1)="0^Error deleting directory"
End DoDot:1
+24 QUIT
CHKDT1 ;Required Data Check
+1 NEW I,C
+2 SET C=1
+3 FOR I="ECDIV","ECHFS","ECOPER"
Begin DoDot:1
+4 IF $GET(@I)=""
SET ^TMP($JOB,"ECMSG",C)="0^Key data missing "_I
SET C=C+1
SET ECERR=1
End DoDot:1
+5 QUIT
