ECMFCAT ;ALB/JAM-Event Capture Management Category Filer ;12 Dec 00
;;2.0; EVENT CAPTURE ;**25**;8 May 96
;
FILE ;Used by the RPC broker to file local procedures in #726
; Variables passed in
; ECC - Category Name
; ECST - Category Status
; ECIEN - Category IEN, if editing
;
; Variable return
; ^TMP($J,"ECMSG",n)=Success or failure to file in #726^Message
;
N ECFLG,ECERR,ERR,ECOST,OCAT,ECRRX,ECCT
S ECERR=0 D CHKDT I ECERR Q
S ECIEN=$G(ECIEN),ECFLG=1
D CHK^DIE(726,.01,,ECC,.ECRRX) I ECRRX="^" D Q
.S ^TMP($J,"ECMSG",1)="0^Invalid Category",ECERR=1
I ECIEN'="" S ECFLG=0 D I ECERR Q
. I '$D(^EC(726,ECIEN,0)) D Q
. . S ECERR=1,^TMP($J,"ECMSG",1)="0^Category Not on File"
. S OCAT=$P($G(^EC(726,ECIEN,0)),U)
S ERR=0 I (ECIEN="")!(ECIEN&($G(OCAT)'=ECC)) D I ECERR Q
.S ECCT=$TR(ECC,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
.I $D(^EC(726,"B",ECC))!($D(^EC(726,"B",ECCT))) D
..S ^TMP($J,"ECMSG",1)="0^Category description exist",ECERR=1
I ECIEN="" D NEWIEN
K DA,DR,DIE
S DIE="^EC(726,",DA=ECIEN,DR=".01////"_ECC
S ECOST=$P($G(^EC(726,ECIEN,0)),U,3),ECOST=$S(ECOST'="":"I",1:"A")
I $G(ECST)'="","^I^A^"[ECST,ECST'=ECOST D
. S DR=DR_";2////"_$S(ECST="I":DT,1:"@")
D ^DIE I $D(DTOUT) D RECDEL S ^TMP($J,"ECMSG",1)="0^Record not Filed" Q
S ^TMP($J,"ECMSG",1)="1^Record Filed"_U_ECIEN
Q
;
RECDEL ; Delete record
I ECFLG S DA=ECIEN,DIK="^EC(726," D ^DIK K DA,DIK
Q
;
NEWIEN ;Create new IEN in file #725
N DIC,DA,DD,DO,DR,DIE
L +^EC(726)
S DIC=726,DIC(0)="L",X=ECC
D FILE^DICN
S ECIEN=+Y
L -^EC(726)
S DIE="^EC(726,",DA=ECIEN,DR="1////"_DT D ^DIE
Q
;
CHKDT ;Required Data Check
N I,C
S C=1
F I="ECC","ECST" 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[HECMFCAT 1840 printed Nov 22, 2024@17:07:46 Page 2
ECMFCAT ;ALB/JAM-Event Capture Management Category Filer ;12 Dec 00
+1 ;;2.0; EVENT CAPTURE ;**25**;8 May 96
+2 ;
FILE ;Used by the RPC broker to file local procedures in #726
+1 ; Variables passed in
+2 ; ECC - Category Name
+3 ; ECST - Category Status
+4 ; ECIEN - Category IEN, if editing
+5 ;
+6 ; Variable return
+7 ; ^TMP($J,"ECMSG",n)=Success or failure to file in #726^Message
+8 ;
+9 NEW ECFLG,ECERR,ERR,ECOST,OCAT,ECRRX,ECCT
+10 SET ECERR=0
DO CHKDT
IF ECERR
QUIT
+11 SET ECIEN=$GET(ECIEN)
SET ECFLG=1
+12 DO CHK^DIE(726,.01,,ECC,.ECRRX)
IF ECRRX="^"
Begin DoDot:1
+13 SET ^TMP($JOB,"ECMSG",1)="0^Invalid Category"
SET ECERR=1
End DoDot:1
QUIT
+14 IF ECIEN'=""
SET ECFLG=0
Begin DoDot:1
+15 IF '$DATA(^EC(726,ECIEN,0))
Begin DoDot:2
+16 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Category Not on File"
End DoDot:2
QUIT
+17 SET OCAT=$PIECE($GET(^EC(726,ECIEN,0)),U)
End DoDot:1
IF ECERR
QUIT
+18 SET ERR=0
IF (ECIEN="")!(ECIEN&($GET(OCAT)'=ECC))
Begin DoDot:1
+19 SET ECCT=$TRANSLATE(ECC,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+20 IF $DATA(^EC(726,"B",ECC))!($DATA(^EC(726,"B",ECCT)))
Begin DoDot:2
+21 SET ^TMP($JOB,"ECMSG",1)="0^Category description exist"
SET ECERR=1
End DoDot:2
End DoDot:1
IF ECERR
QUIT
+22 IF ECIEN=""
DO NEWIEN
+23 KILL DA,DR,DIE
+24 SET DIE="^EC(726,"
SET DA=ECIEN
SET DR=".01////"_ECC
+25 SET ECOST=$PIECE($GET(^EC(726,ECIEN,0)),U,3)
SET ECOST=$SELECT(ECOST'="":"I",1:"A")
+26 IF $GET(ECST)'=""
IF "^I^A^"[ECST
IF ECST'=ECOST
Begin DoDot:1
+27 SET DR=DR_";2////"_$SELECT(ECST="I":DT,1:"@")
End DoDot:1
+28 DO ^DIE
IF $DATA(DTOUT)
DO RECDEL
SET ^TMP($JOB,"ECMSG",1)="0^Record not Filed"
QUIT
+29 SET ^TMP($JOB,"ECMSG",1)="1^Record Filed"_U_ECIEN
+30 QUIT
+31 ;
RECDEL ; Delete record
+1 IF ECFLG
SET DA=ECIEN
SET DIK="^EC(726,"
DO ^DIK
KILL DA,DIK
+2 QUIT
+3 ;
NEWIEN ;Create new IEN in file #725
+1 NEW DIC,DA,DD,DO,DR,DIE
+2 LOCK +^EC(726)
+3 SET DIC=726
SET DIC(0)="L"
SET X=ECC
+4 DO FILE^DICN
+5 SET ECIEN=+Y
+6 LOCK -^EC(726)
+7 SET DIE="^EC(726,"
SET DA=ECIEN
SET DR="1////"_DT
DO ^DIE
+8 QUIT
+9 ;
CHKDT ;Required Data Check
+1 NEW I,C
+2 SET C=1
+3 FOR I="ECC","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
