source: WorldVistAEHR/trunk/r/EVENT_CAPTURE-EC--ECT--ECX/ECMFLPX.m@ 1073

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

initial load of WorldVistAEHR

File size: 2.3 KB
RevLine 
[613]1ECMFLPX ;ALB/JAM-Event Capture Management Local Procedure Filer ;1 Dec 00
2 ;;2.0; EVENT CAPTURE ;**25,87**;8 May 96;Build 1
3 ;
4FILE ;Used by the RPC broker to file local procedures in #725
5 ; Variables passed in
6 ; ECIEN - IEN of #725, if editing
7 ; ECPN - Local Procedure Name
8 ; ECNA - National Number
9 ; ECST - Active/Inactive Status
10 ; ECSYN - Synonym
11 ; ECPT - CPT Code
12 ;
13 ; Variable return
14 ; ^TMP($J,"ECMSG",n)=Success or failure to file in #725^Message
15 ;
16 N ECFLG,ECERR,ERR,ECOST,ECDAT,ONM,ONA,ECRES
17 S ECERR=0 D CHKDT I ECERR Q
18 S ECIEN=$G(ECIEN),ECFLG=1
19 I $L(ECNA)'=5 D Q
20 .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Procedure Number"
21 I $G(ECPT)'="" D I ECERR Q
22 .D CHK^DIE(725,4,,ECPT,.ECRES) I +ECRES<1 D Q
23 ..S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid CPT Code"
24 I ECIEN'="" S ECFLG=0 D I ECERR Q
25 .I '$D(^EC(725,ECIEN,0)) D Q
26 ..S ECERR=1,^TMP($J,"ECMSG",1)="0^Local Procedure Not on File" Q
27 .I ECIEN<90001 D Q
28 ..S ECERR=1,^TMP($J,"ECMSG",1)="0^National Procedure cant be changed"
29 .S ECDAT=$G(^EC(725,ECIEN,0)),ONM=$P(ECDAT,U),ONA=$P(ECDAT,U,2)
30 S ERR=0 D PXCHK^ECUMRPC1(.ERR,ECPN_"^"_ECNA) D I ECERR Q
31 .I +ERR,(ECIEN="")!(ECIEN&($G(ONM)'=ECPN)) D Q
32 ..S ^TMP($J,"ECMSG",1)="0^Procedure description already exist",ECERR=1
33 .I +$P(ERR,U,2),(ECIEN="")!(ECIEN&($G(ONA)'=ECNA)) D
34 ..S ^TMP($J,"ECMSG",1)="0^Procedure number already exist",ECERR=1
35 I ECIEN="" D I ECERR Q
36 . D NEWIEN
37 K DA,DR,DIE
38 S DIE="^EC(725,",DA=ECIEN
39 S ECOST=$P($G(^EC(725,ECIEN,0)),U,3),ECOST=$S(ECOST'="":"I",1:"A")
40 S DR=".01////"_ECPN_";1////"_ECNA_";3////"_$G(ECSYN)_";4////"_$G(ECPT)
41 I $G(ECST)'="","^I^A^"[ECST,ECST'=ECOST D
42 .S DR=DR_";2////"_$S(ECST="I":DT,1:"@")
43 D ^DIE I $D(DTOUT) D RECDEL D Q
44 . S ^TMP($J,"ECMSG",1)="0^Record not Filed"
45 S ^TMP($J,"ECMSG",1)="1^Record Filed"_U_ECIEN
46 Q
47 ;
48RECDEL ; Delete record
49 I ECFLG S DA=ECIEN,DIK="^EC(725," D ^DIK K DA,DIK
50 Q
51 ;
52NEWIEN ;Create new IEN in file #725
53 N DIC,DA,DD,DO
54 L +^EC(725)
55 S ECIEN=$O(^EC(725,"A"),-1)
56 F S ECIEN=ECIEN+1 Q:'$D(^EC(725,ECIEN))
57 I ECIEN<90001 S ECIEN=90001
58 S $P(^EC(725,0),U,3)=ECIEN,$P(^EC(725,0),U,4)=$P(^EC(725,0),U,4)+1
59 L -^EC(725)
60 Q
61 ;
62CHKDT ;Required Data Check
63 N I,C
64 S C=1
65 F I="ECPN","ECNA" D
66 .I $G(@I)="" S ^TMP($J,"ECMSG",C)="0^Key data missing "_I,C=C+1,ECERR=1
67 Q
Note: See TracBrowser for help on using the repository browser.