ECMFLPX ;ALB/JAM-Event Capture Management Local Procedure Filer ;12/5/16 15:42
;;2.0;EVENT CAPTURE;**25,87,134**;8 May 96;Build 12
;
FILE ;Used by the RPC broker to file local procedures in #725
; Variables passed in
; ECIEN - IEN of #725, if editing
; ECPN - Local Procedure Name
; ECNA - National Number
; ECST - Active/Inactive Status
; ECSYN - Synonym
; ECPT - CPT Code
;
; Variable return
; ^TMP($J,"ECMSG",n)=Success or failure to file in #725^Message
;
N ECFLG,ECERR,ERR,ECOST,ECDAT,ONM,ONA,ECRES
S ECERR=0 D CHKDT I ECERR Q
S ECIEN=$G(ECIEN),ECFLG=1
I $L(ECNA)'=5 D Q
.S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Procedure Number"
I $G(ECPT)'="",$G(ECPT)'="@" D I ECERR Q ;134 allow "@" so value can be deleted
.D CHK^DIE(725,4,,ECPT,.ECRES) I +ECRES<1 D Q
..S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid CPT Code"
I ECIEN'="" S ECFLG=0 D I ECERR Q
.I '$D(^EC(725,ECIEN,0)) D Q
..S ECERR=1,^TMP($J,"ECMSG",1)="0^Local Procedure Not on File" Q
.I ECIEN<90001 D Q
..S ECERR=1,^TMP($J,"ECMSG",1)="0^National Procedure cant be changed"
.S ECDAT=$G(^EC(725,ECIEN,0)),ONM=$P(ECDAT,U),ONA=$P(ECDAT,U,2)
S ERR=0 D PXCHK^ECUMRPC1(.ERR,ECPN_"^"_ECNA) D I ECERR Q
.I +ERR,(ECIEN="")!(ECIEN&($G(ONM)'=ECPN)) D Q
..S ^TMP($J,"ECMSG",1)="0^Procedure description already exist",ECERR=1
.I +$P(ERR,U,2),(ECIEN="")!(ECIEN&($G(ONA)'=ECNA)) D
..S ^TMP($J,"ECMSG",1)="0^Procedure number already exist",ECERR=1
I ECIEN="" D I ECERR Q
. D NEWIEN
K DA,DR,DIE
S DIE="^EC(725,",DA=ECIEN
S ECOST=$P($G(^EC(725,ECIEN,0)),U,3),ECOST=$S(ECOST'="":"I",1:"A")
S DR=".01////"_ECPN_";1////"_ECNA_";3////"_$G(ECSYN)_";4////"_$G(ECPT)
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 D Q
. S ^TMP($J,"ECMSG",1)="0^Record not Filed"
S ^TMP($J,"ECMSG",1)="1^Record Filed"_U_ECIEN
Q
;
RECDEL ; Delete record
I ECFLG S DA=ECIEN,DIK="^EC(725," D ^DIK K DA,DIK
Q
;
NEWIEN ;Create new IEN in file #725
N DIC,DA,DD,DO
L +^EC(725)
S ECIEN=$O(^EC(725,"A"),-1)
F S ECIEN=ECIEN+1 Q:'$D(^EC(725,ECIEN))
I ECIEN<90001 S ECIEN=90001
S $P(^EC(725,0),U,3)=ECIEN,$P(^EC(725,0),U,4)=$P(^EC(725,0),U,4)+1
L -^EC(725)
Q
;
CHKDT ;Required Data Check
N I,C
S C=1
F I="ECPN","ECNA" 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[HECMFLPX 2460 printed Nov 22, 2024@17:07:50 Page 2
ECMFLPX ;ALB/JAM-Event Capture Management Local Procedure Filer ;12/5/16 15:42
+1 ;;2.0;EVENT CAPTURE;**25,87,134**;8 May 96;Build 12
+2 ;
FILE ;Used by the RPC broker to file local procedures in #725
+1 ; Variables passed in
+2 ; ECIEN - IEN of #725, if editing
+3 ; ECPN - Local Procedure Name
+4 ; ECNA - National Number
+5 ; ECST - Active/Inactive Status
+6 ; ECSYN - Synonym
+7 ; ECPT - CPT Code
+8 ;
+9 ; Variable return
+10 ; ^TMP($J,"ECMSG",n)=Success or failure to file in #725^Message
+11 ;
+12 NEW ECFLG,ECERR,ERR,ECOST,ECDAT,ONM,ONA,ECRES
+13 SET ECERR=0
DO CHKDT
IF ECERR
QUIT
+14 SET ECIEN=$GET(ECIEN)
SET ECFLG=1
+15 IF $LENGTH(ECNA)'=5
Begin DoDot:1
+16 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid Procedure Number"
End DoDot:1
QUIT
+17 ;134 allow "@" so value can be deleted
IF $GET(ECPT)'=""
IF $GET(ECPT)'="@"
Begin DoDot:1
+18 DO CHK^DIE(725,4,,ECPT,.ECRES)
IF +ECRES<1
Begin DoDot:2
+19 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid CPT Code"
End DoDot:2
QUIT
End DoDot:1
IF ECERR
QUIT
+20 IF ECIEN'=""
SET ECFLG=0
Begin DoDot:1
+21 IF '$DATA(^EC(725,ECIEN,0))
Begin DoDot:2
+22 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Local Procedure Not on File"
QUIT
End DoDot:2
QUIT
+23 IF ECIEN<90001
Begin DoDot:2
+24 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^National Procedure cant be changed"
End DoDot:2
QUIT
+25 SET ECDAT=$GET(^EC(725,ECIEN,0))
SET ONM=$PIECE(ECDAT,U)
SET ONA=$PIECE(ECDAT,U,2)
End DoDot:1
IF ECERR
QUIT
+26 SET ERR=0
DO PXCHK^ECUMRPC1(.ERR,ECPN_"^"_ECNA)
Begin DoDot:1
+27 IF +ERR
IF (ECIEN="")!(ECIEN&($GET(ONM)'=ECPN))
Begin DoDot:2
+28 SET ^TMP($JOB,"ECMSG",1)="0^Procedure description already exist"
SET ECERR=1
End DoDot:2
QUIT
+29 IF +$PIECE(ERR,U,2)
IF (ECIEN="")!(ECIEN&($GET(ONA)'=ECNA))
Begin DoDot:2
+30 SET ^TMP($JOB,"ECMSG",1)="0^Procedure number already exist"
SET ECERR=1
End DoDot:2
End DoDot:1
IF ECERR
QUIT
+31 IF ECIEN=""
Begin DoDot:1
+32 DO NEWIEN
End DoDot:1
IF ECERR
QUIT
+33 KILL DA,DR,DIE
+34 SET DIE="^EC(725,"
SET DA=ECIEN
+35 SET ECOST=$PIECE($GET(^EC(725,ECIEN,0)),U,3)
SET ECOST=$SELECT(ECOST'="":"I",1:"A")
+36 SET DR=".01////"_ECPN_";1////"_ECNA_";3////"_$GET(ECSYN)_";4////"_$GET(ECPT)
+37 IF $GET(ECST)'=""
IF "^I^A^"[ECST
IF ECST'=ECOST
Begin DoDot:1
+38 SET DR=DR_";2////"_$SELECT(ECST="I":DT,1:"@")
End DoDot:1
+39 DO ^DIE
IF $DATA(DTOUT)
DO RECDEL
Begin DoDot:1
+40 SET ^TMP($JOB,"ECMSG",1)="0^Record not Filed"
End DoDot:1
QUIT
+41 SET ^TMP($JOB,"ECMSG",1)="1^Record Filed"_U_ECIEN
+42 QUIT
+43 ;
RECDEL ; Delete record
+1 IF ECFLG
SET DA=ECIEN
SET DIK="^EC(725,"
DO ^DIK
KILL DA,DIK
+2 QUIT
+3 ;
NEWIEN ;Create new IEN in file #725
+1 NEW DIC,DA,DD,DO
+2 LOCK +^EC(725)
+3 SET ECIEN=$ORDER(^EC(725,"A"),-1)
+4 FOR
SET ECIEN=ECIEN+1
if '$DATA(^EC(725,ECIEN))
QUIT
+5 IF ECIEN<90001
SET ECIEN=90001
+6 SET $PIECE(^EC(725,0),U,3)=ECIEN
SET $PIECE(^EC(725,0),U,4)=$PIECE(^EC(725,0),U,4)+1
+7 LOCK -^EC(725)
+8 QUIT
+9 ;
CHKDT ;Required Data Check
+1 NEW I,C
+2 SET C=1
+3 FOR I="ECPN","ECNA"
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
