125 lines
4.8 KiB
Mathematica
125 lines
4.8 KiB
Mathematica
ECMFECS ;ALB/JAM-Event Capture Management - Event Code Screen Filer;27 Nov 00
|
|
;;2.0; EVENT CAPTURE ;**25,33,47,55,65**;8 May 96
|
|
;
|
|
FILE ;Used by the RPC broker to file EC Code Screens in file #720.3
|
|
; Variables passed in
|
|
; ECIEN - IEN of #720.3, if editing
|
|
; ECL - Location
|
|
; ECD - DSS Unit
|
|
; ECC - Category
|
|
; ECP - Procedure
|
|
; ECST - Event code screen status
|
|
; ECSYN - Synonym
|
|
; ECVOL - Volume
|
|
; ECAC - Associated Clinic
|
|
; ECREAS - Reason indicator
|
|
; ECRES0..n - array of reasons
|
|
;
|
|
; Variable return
|
|
; ^TMP($J,"ECMSG",n)=Success or failure to file in #720.3^Message
|
|
;
|
|
N ECCH,ECERR,ECX,ECY,ECFLG,ECR,ECI,X,Y,DIK,DIE
|
|
S ECERR=0 D CHKDT I ECERR Q
|
|
D VALDATA I ECERR Q
|
|
I ECIEN'="" S ECFLG=0,ECX=$G(^ECJ(ECIEN,0)),ECY=$P(ECX,U) D I ECERR Q
|
|
.I ECX="" D Q
|
|
..S ECERR=1,^TMP($J,"ECMSG",1)="0^Event Code Screen Not on File" Q
|
|
.S ECL=$P(ECY,"-"),ECD=$P(ECY,"-",2),ECC=$P(ECY,"-",3),ECP=$P(ECY,"-",4)
|
|
.I ECST="A",$P(ECX,U,2)'="" S DA=ECIEN,DIE="^ECJ(",DR="1///@" D ^DIE Q
|
|
.I ECST="I",$P(ECX,U,2)="" S $P(^ECJ(ECIEN,0),U,2)=DT
|
|
S ECC=$G(ECC,0),ECCH=ECL_"-"_ECD_"-"_ECC_"-"_ECP
|
|
I '$P($G(^ECD(ECD,0)),U,11),ECC D Q
|
|
.S ECERR=1,^TMP($J,"ECMSG",1)="0^DSS Unit/Category inconsistency" Q
|
|
I ECIEN="" D I ECERR Q
|
|
.I $D(^ECJ("B",ECCH)) D Q
|
|
..S ECERR=1,^TMP($J,"ECMSG",1)="0^EC Screen Exist" Q
|
|
.D NEWIEN
|
|
S DA=ECIEN,DIK="^ECJ(",ECREAS=$S(ECREAS="Y":1,1:0) D IX^DIK
|
|
S ^ECJ("AP",ECL,ECD,ECC,ECP,ECIEN)="",^ECJ("APP",ECL,ECD,ECP,ECIEN)=""
|
|
S $P(^ECJ(ECIEN,"PRO"),U)=ECP,ECAC=$S($G(ECAC)'="":ECAC,1:"@")
|
|
S DR="53////"_$S($G(ECSYN)'="":ECSYN,1:"@")_";54////"_$G(ECVOL,1)
|
|
S DR=DR_";55////"_$G(ECAC)_";56////"_ECREAS,DIE="^ECJ(",DA=ECIEN
|
|
D ^DIE K DA,DR,DIE
|
|
I $D(DTOUT) D RECDEL S ^TMP($J,"ECMSG",1)="0^Record not Filed" Q
|
|
I ECREAS D
|
|
.K DIC,DA,DR,ECX S DIC="^ECL(",DIC(0)="L",DLAYGO=720.5,ECR=0
|
|
.F ECI=0:1 S ECX="ECRES"_ECI Q:'$D(@ECX) S ECR=(@ECX) D
|
|
..Q:ECR="" I '$D(^ECR(ECR,0)) Q
|
|
..I '$D(^ECL("AD",ECIEN,ECR)) S X=ECR,DIC("DR")=".02////"_ECIEN
|
|
..K DD,DO,DLAYGO D FILE^DICN
|
|
S ^TMP($J,"ECMSG",1)="1^Record Filed"_U_ECIEN
|
|
Q
|
|
;
|
|
VALDATA ;validate data
|
|
N ECRRX,ECRES
|
|
S DIC="^DIC(4,",DIC(0)="NX",X=ECL D ^DIC I Y=-1 D Q
|
|
.S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Location"
|
|
S DIC="^ECD(",DIC(0)="NX",X=ECD D ^DIC I Y=-1 D Q
|
|
.S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid DSS Unit"
|
|
I ECC S DIC="^EC(726,",DIC(0)="NX",X=ECC D ^DIC I Y=-1 D Q
|
|
.S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Category"
|
|
I ECP'="" D I ECERR Q
|
|
.; ATG-1003-32110 : by VMP
|
|
.I ECP["ICPT" S ECRRX=$$CPT^ICPTCOD(+ECP) I +ECRRX>0 Q:$G(ECIEN) I $P(ECRRX,U,7) Q
|
|
.I ECP["EC",$D(^EC(725,+ECP,0)) Q
|
|
.S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Procedure"
|
|
I $G(ECAC)'="" D I ECERR Q
|
|
.D CHK^DIE(720.3,55,"E","`"_ECAC,.ECRRX) I ECRRX'=ECAC D Q
|
|
..S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Associated Clinic"
|
|
.S ECRES=$$CLNCK^SDUTL2(ECAC,0) I 'ECRES D S ECERR=1
|
|
..S ^TMP($J,"ECMSG",1)=ECRES_" Clinic MUST be corrected before filing."
|
|
I $G(ECSYN)'="" D CHK^DIE(720.3,53,"E",ECSYN,.ECRRX) I ECRRX'=ECSYN D Q
|
|
.S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Synonym"
|
|
I "^N^Y^"'[U_ECREAS_U D Q
|
|
.S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Reason Response"
|
|
Q
|
|
RECDEL ; Delete record
|
|
I ECFLG S DA=ECIEN,DIK="^ECJ(" D ^DIK K DA,DIK
|
|
Q
|
|
;
|
|
NEWIEN ;Create new IEN in file #720.3
|
|
N DIC,DA,DD,DO
|
|
L +^ECJ(0)
|
|
S X=ECCH,DIC="^ECJ(",DIC(0)="L",DLAYGO=720.3 D FILE^DICN
|
|
L -^ECJ(0)
|
|
S ECIEN=+Y,$P(^ECJ(ECIEN,0),U,3)=DT,$P(^ECJ(ECIEN,"PRO"),U)=ECP
|
|
I ECST="I" S $P(^ECJ(ECIEN,0),U,2)=DT
|
|
Q
|
|
CHKDT ;Required Data Check
|
|
N I,C
|
|
S C=1
|
|
F I="ECL","ECD","ECC","ECP","ECREAS" D
|
|
.I $G(@I)="" S ^TMP($J,"ECMSG",C)="0^Key data missing "_I,C=C+1,ECERR=1
|
|
Q
|
|
REASON ;Used by the RPC broker to file EC Reasons in file #720.4
|
|
; Variables passed in
|
|
; ECIEN - IEN of #720.4, if editing
|
|
; ECRES - Reason
|
|
; ECST - Reason status
|
|
;
|
|
; Variable return
|
|
; ^TMP($J,"ECMSG",n)=Success or failure to file in #720.4^Message
|
|
;
|
|
N ECOST,ECERR,ECFLG,X,Y,DIC,DIE
|
|
S ECERR=0 I $G(ECRES)="" D I ECERR Q
|
|
.S ^TMP($J,"ECMSG",1)="0^Key data missing - Reason",ECERR=1
|
|
D CHK^DIE(720.4,.01,,ECRES,.ECRRX) I ECRRX="^" D Q
|
|
.S ^TMP($J,"ECMSG",1)="0^Invalid Reason",ECERR=1
|
|
S ECST=$G(ECST,"A")
|
|
I "^I^A^"'[U_ECST_U S ^TMP($J,"ECMSG",1)="0^Invalid Reason Status" Q
|
|
S ECST=$S(ECST="I":0,1:1),ECIEN=$G(ECIEN),ECFLG=1
|
|
I ECIEN'="" S ECFLG=0 I $G(^ECR(ECIEN,0))="" D I ECERR K ECST Q
|
|
.S ECERR=1,^TMP($J,"ECMSG",1)="0^Reason Not on File" Q
|
|
I ECIEN="" D I ECERR K ECST Q
|
|
.I $D(^ECR("B",ECRES)) S ECERR=1,^TMP($J,"ECMSG",1)="0^Reason Exist" Q
|
|
.K DIE,DR,DA
|
|
.L +^ECR(0)
|
|
.S X=ECRES,DIC="^ECR(",DIC(0)="L",DLAYGO=720.4 D FILE^DICN
|
|
.L -^ECR(0)
|
|
.S ECIEN=+Y
|
|
S ECOST=$P($G(^ECR(ECIEN,0)),U,2)
|
|
I ECST'=ECOST D
|
|
.S DIE=DIC,DA=ECIEN,DR=".02////"_ECST D ^DIE
|
|
S ^TMP($J,"ECMSG",1)="1^Reason Filed"_U_ECIEN K ECST
|
|
Q
|