- 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 Mar 13, 2025@21:02:21 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
