ECMFDSSU ;ALB/JAM-Event Capture Management Filer DSS Unit ;20 Nov 00 ;;2.0; EVENT CAPTURE ;**25,30,33**;8 May 96 ; FILE ;Used by the RPC broker to file DSS Units in file #724 ; Variables passed in ; ECIEN - IEN of #724, if editing ; ECDUNM - DSS Unit Name ; ECS - Service ; ECM - Medical Speciality ; ECTR - Cost Center ; ECUN - Unit Number ; ECST - Status Flag (Active/Inactive) ; ECASC - Associated Stop Code ; ECC - Category ; ECDFDT - Default Data Entry Date ; ECPCE - Send to PCE ; ECSCN - Event Code Screens status ; ; Variable return ; ^TMP($J,"ECMSG",n)=Success or failure to file in #724^Message ; N ECERR,ECX,ECFLG,ECRES,ECONAM S ECERR=0 D CHKDT I ECERR Q D VALDATA I ECERR Q S ECIEN=$G(ECIEN),ECFLG=1,ECONAM="",ECC=$S(ECC="Y":1,1:0) I ECIEN'="" S ECFLG=0 D I ECERR D END Q . I '$D(^ECD(ECIEN,0)) D Q . . S ECERR=1,^TMP($J,"ECMSG",1)="0^DSS Unit Not on File" Q . D CATCHK^ECUMRPC1(.ECRES,ECIEN) I ECRES,ECC'=$P(^ECD(ECIEN,0),U,11) D . . S ECERR=1,^TMP($J,"ECMSG",1)="0^Category Changed, EC Screen exist" . S ECONAM=$P($G(^ECD(ECIEN,0)),U) D I ECERR D END Q ;Check name . I (ECFLG)!((ECONAM'="")&(ECONAM'=ECDUNM)),$D(^ECD("B",ECDUNM)) D Q . . S ECERR=1,^TMP($J,"ECMSG",1)="0^DSS Unit Name already exist" . I 'ECFLG K DIE S DIE="^ECD(",DA=ECIEN,DR=".01////"_ECDUNM D ^DIE S ECPCE=$S(ECPCE="A":"A",ECPCE="O":"O",1:"N") I ECPCE="N",$G(ECASC)="" D D END Q . S ECERR=1,^TMP($J,"ECMSG",1)="0^No associated clinic, Send to PCE=N" I ECIEN="" D NEWIEN K DA,DR,DIE S ECST=$E($G(ECST)),ECST=$S(ECST="I":1,1:0),ECDFDT=$E($G(ECDFDT)) S ECDFDT=$S(ECDFDT="N":"N",1:"X"),DIE="^ECD(",DA=ECIEN S DR="1////"_ECS_";2////"_ECM_";3////"_ECTR_";4////"_$G(ECUN) S DR=DR_";5////"_ECST_";7////1;9////"_$S(ECPCE'="N":"@",1:$G(ECASC)) S DR=DR_";10////"_ECC_";11////"_ECDFDT_";13////"_ECPCE D ^DIE I $D(DTOUT) D RECDEL D D END Q . S ^TMP($J,"ECMSG",1)="0^DSS Unit Record not Filed" I 'ECFLG D ECSCRNS S ^TMP($J,"ECMSG",1)="1^DSS Unit Record Filed"_U_ECIEN END K DIE,DIC,DR,DA,DO,ECIEN Q VALDATA ;validate data N ECRRX D CHK^DIE(724,.01,"E",ECDUNM,.ECRRX) I ECRRX'=ECDUNM D Q .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid DSS Unit Name" D CHK^DIE(724,1,"E","`"_ECS,.ECRRX) I ECRRX'=ECS D Q .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Service" D CHK^DIE(724,2,"E","`"_ECM,.ECRRX) I ECRRX'=ECM D Q .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Medical Speciality" D CHK^DIE(724,3,"E","`"_ECTR,.ECRRX) I ECRRX'=ECTR D Q .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Cost Center" I $G(ECUN)'="" D CHK^DIE(724,4,"E",ECUN,.ECRRX) I ECRRX'=ECUN D Q .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Unit Number" I $G(ECASC)'="" D CHK^DIE(724,9,"E","`"_ECASC,.ECRRX) I ECRRX'=ECASC D Q .S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Associated Clinic" Q ECSCRNS ;Determine if event codes should be updated based on change of DSS Unit ;status ; DSS Unit status changed from Active to Inactive, if EC screen status ; A - retain, do nothing, B - inactiviate ; DSS Unit status changed from Inactive to Active, if EC screen status ; C - reactiviate, D - remain inactive ; N ECD,ECINC,ZTDESC,ZTSAVE,ZTIO,ZTRTN,ZTDTH I ($G(ECSCN)="")!(ECSCN="A")!(ECSCN="D") Q I "^B^C^"']"^"_ECSCN_"^" Q S ECD=ECIEN,ECINC=DT I ECSCN="B" D .S ZTDESC="DEALLOCATE DSS UNIT & INACTIVATE EVENT CODE SCREENS" I ECSCN="C" D .S ZTDESC="REACTIVIATE EVENT CODE SCREENS",ECINC="@" S ZTRTN=$S(ECSCN="B":"DIK",1:"INSCRN")_"^ECDEAL",ZTDTH=$H N ECSCN S ECSCN=1,(ZTSAVE("ECD"),ZTSAVE("ECSCN"),ZTSAVE("ECINC"))="",ZTIO="" D ^%ZTLOAD K ZTSK Q D @ZTRTN Q ; RECDEL ; Delete record I ECFLG S DA=ECIEN,DIK="^ECD(" D ^DIK K DA,DIK Q NEWIEN ;Create new IEN in file #724 N DIC,DA,DD,DO L +^ECD(0) S DIC=724,DIC(0)="L",X=ECDUNM D FILE^DICN L -^ECD(0) S ECIEN=+Y Q CHKDT ;Required Data Check N I,C S C=1 F I="ECDUNM","ECS","ECM","ECTR","ECC" D .I $G(@I)="" S ^TMP($J,"ECMSG",C)="0^Key data missing "_I,C=C+1,ECERR=1 Q USER ;Used by the RPC broker to allocate or de-allocate users for DSS Units ;in file #200 ; Variables passed in ; ECIEN - IEN of DSS Unit in file #724 ; ECUSR0..n - Users to allocate/deallocate to DSS Unit ; ; Variable return ; ^TMP($J,"ECMSG",n)=Success or failure to file in #724^Message ; N EDUZ,ECERR,ECI,ECX,USER,DIC,DIK,X,Y,DA S (EDUZ,ECERR)=0,ECIEN=$G(ECIEN) I ECIEN="" S ^TMP($J,"ECMSG",1)="0^DSS Unit missing" Q D I ECERR Q . I '$D(^ECD(ECIEN,0)) D . . S ECERR=1,^TMP($J,"ECMSG",1)="0^DSS Unit Not on File" F ECI=0:1 S ECX="ECUSR"_ECI Q:'$D(@ECX) S:@ECX'="" USER(@ECX)="" F S EDUZ=$O(^VA(200,EDUZ)) Q:'EDUZ I $D(^VA(200,EDUZ,"EC",ECIEN,0)) D . I $D(USER(EDUZ)) K USER(EDUZ) Q . K DA,DIK S DA(1)=EDUZ,DA=ECIEN,DIK="^VA(200,"_DA(1)_",""EC""," . D ^DIK K USER(EDUZ) ;add users for DSS Unit S EDUZ=0 F S EDUZ=$O(USER(EDUZ)) Q:'EDUZ D . K DIC,DD,DO S DIC=200,DIC(0)="QNMX",X=EDUZ D ^DIC I Y<0 Q . K DIC,DD,DO S DIC(0)="L",DA(1)=EDUZ,DIC("P")=$P(^DD(200,720,0),U,2) . S DINUM=ECIEN,DIC="^VA(200,"_DA(1)_",""EC"",",X=ECIEN . D FILE^DICN S ^TMP($J,"ECMSG",1)="1^Record Filed"_U_ECIEN K DINUM Q DSSU ;Used by the RPC broker to allocate or de-allocate DSS Units for a user ;in file #200 ; Variables passed in ; ECIEN - User IEN in file #200 ; ECD0..n - IEN of DSS Unit in file #724 to allocate/deallocate ; ; ; Variable return ; ^TMP($J,"ECMSG",n)=Success or failure to file in #200^Message ; N EDU,ECERR,ECI,ECX,ECDSSU,DIC,DIK,DA,X,Y S (EDU,ECERR)=0,ECIEN=$G(ECIEN) I ECIEN="" S ^TMP($J,"ECMSG",1)="0^User missing" Q D I ECERR Q . S DIC=200,DIC(0)="QNX",X=ECIEN D ^DIC D:Y<0 . . S ECERR=1,^TMP($J,"ECMSG",1)="0^User Not on File" F ECI=0:1 S ECX="ECD"_ECI Q:'$D(@ECX) S:@ECX'="" ECDSSU(@ECX)="" F S EDU=$O(^VA(200,ECIEN,"EC",EDU)) Q:'EDU D . I $D(ECDSSU(EDU)) K ECDSSU(EDU) Q . K DA,DIK S DA(1)=ECIEN,DA=EDU,DIK="^VA(200,"_DA(1)_",""EC""," . D ^DIK ;add DSS Units for user S EDU=0 F S EDU=$O(ECDSSU(EDU)) Q:'EDU D . I '$D(^ECD(EDU,0)) Q . K DIC,DD,DO S DIC(0)="L",DA(1)=ECIEN,DIC("P")=$P(^DD(200,720,0),U,2) . S DINUM=EDU,DIC="^VA(200,"_DA(1)_",""EC"",",X=EDU . D FILE^DICN S ^TMP($J,"ECMSG",1)="1^Record Filed"_U_ECIEN Q