source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECMFCAT.m@ 1604

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

initial load of WorldVistAEHR

File size: 1.7 KB
Line 
1ECMFCAT ;ALB/JAM-Event Capture Management Category Filer ;12 Dec 00
2 ;;2.0; EVENT CAPTURE ;**25**;8 May 96
3 ;
4FILE ;Used by the RPC broker to file local procedures in #726
5 ; Variables passed in
6 ; ECC - Category Name
7 ; ECST - Category Status
8 ; ECIEN - Category IEN, if editing
9 ;
10 ; Variable return
11 ; ^TMP($J,"ECMSG",n)=Success or failure to file in #726^Message
12 ;
13 N ECFLG,ECERR,ERR,ECOST,OCAT,ECRRX,ECCT
14 S ECERR=0 D CHKDT I ECERR Q
15 S ECIEN=$G(ECIEN),ECFLG=1
16 D CHK^DIE(726,.01,,ECC,.ECRRX) I ECRRX="^" D Q
17 .S ^TMP($J,"ECMSG",1)="0^Invalid Category",ECERR=1
18 I ECIEN'="" S ECFLG=0 D I ECERR Q
19 . I '$D(^EC(726,ECIEN,0)) D Q
20 . . S ECERR=1,^TMP($J,"ECMSG",1)="0^Category Not on File"
21 . S OCAT=$P($G(^EC(726,ECIEN,0)),U)
22 S ERR=0 I (ECIEN="")!(ECIEN&($G(OCAT)'=ECC)) D I ECERR Q
23 .S ECCT=$TR(ECC,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
24 .I $D(^EC(726,"B",ECC))!($D(^EC(726,"B",ECCT))) D
25 ..S ^TMP($J,"ECMSG",1)="0^Category description exist",ECERR=1
26 I ECIEN="" D NEWIEN
27 K DA,DR,DIE
28 S DIE="^EC(726,",DA=ECIEN,DR=".01////"_ECC
29 S ECOST=$P($G(^EC(726,ECIEN,0)),U,3),ECOST=$S(ECOST'="":"I",1:"A")
30 I $G(ECST)'="","^I^A^"[ECST,ECST'=ECOST D
31 . S DR=DR_";2////"_$S(ECST="I":DT,1:"@")
32 D ^DIE I $D(DTOUT) D RECDEL S ^TMP($J,"ECMSG",1)="0^Record not Filed" Q
33 S ^TMP($J,"ECMSG",1)="1^Record Filed"_U_ECIEN
34 Q
35 ;
36RECDEL ; Delete record
37 I ECFLG S DA=ECIEN,DIK="^EC(726," D ^DIK K DA,DIK
38 Q
39 ;
40NEWIEN ;Create new IEN in file #725
41 N DIC,DA,DD,DO,DR,DIE
42 L +^EC(726)
43 S DIC=726,DIC(0)="L",X=ECC
44 D FILE^DICN
45 S ECIEN=+Y
46 L -^EC(726)
47 S DIE="^EC(726,",DA=ECIEN,DR="1////"_DT D ^DIE
48 Q
49 ;
50CHKDT ;Required Data Check
51 N I,C
52 S C=1
53 F I="ECC","ECST" D
54 .I $G(@I)="" S ^TMP($J,"ECMSG",C)="0^Key data missing "_I,C=C+1,ECERR=1
55 Q
Note: See TracBrowser for help on using the repository browser.