ECMFDSSU ;ALB/JAM-Event Capture Management Filer DSS Unit ;2/6/18 14:41
;;2.0;EVENT CAPTURE ;**25,30,33,126,131,139**;8 May 96;Build 7
;
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
; ECCSC - Credit stop code, can be used when PCE status is
; no records
; ECHAR4 - CHAR4 code, can be used when PCE status is no records
; ECADUP - DSS Unit allows duplicate records during upload
;
; 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
. . I ECC=0 D FIXSCRNS Q ;131 If Category changed to no, update existing event code screens
. . 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="OOS":"OOS",1:"N") ;139
I ECPCE'="A",$G(ECASC)="" D D END Q ;139
. S ECERR=1,^TMP($J,"ECMSG",1)="0^No associated stop code, send to PCE setting requires an associated stop code" ;126,139 Corrected error message
I 'ECFLG,ECPCE'="A",$P($G(^ECD(+$G(ECIEN),0)),U,14)="A" D UPDSCRN ;131,139 If existing DSS Unit and PCE is changing from All records then update related EC screens
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="A":"@",1:$G(ECASC)) ;139
S DR=DR_";10////"_ECC_";11////"_ECDFDT_";13////"_ECPCE
S DR=DR_";14////"_$S(ECPCE="A":"@",$G(ECCSC)="":"@",1:$G(ECCSC))_";15////"_$S(ECPCE'="N":"@",$G(ECHAR4)="":"@",1:$G(ECHAR4)) ;126,139 Add credit stop and char4 fields, 139 Update logic for deleting stop code
S DR=DR_";16////"_$G(ECADUP,"N") ;139 Does DSS Unit allow duplicate records to be uploaded
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 Stop Code" ;126 Corrected error message
I $G(ECCSC)'="" D CHK^DIE(724,14,"E","`"_ECCSC,.ECRRX) I ECRRX'=ECCSC S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid Credit Stop Code" Q ;126
I $G(ECHAR4)'="" D CHK^DIE(724,15,"E","`"_ECHAR4,.ECRRX) I ECRRX'=ECHAR4 S ECERR=1,^TMP($J,"ECMSG",1)="0^Invalid CHAR4 Code" Q ;126
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):3 ;126 Added lock time out as required by standard
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
;
UPDSCRN ;131 Section added to remove default associated clinic from event capture screens for a specific DSS Unit
N LOC,CAT,PROC,DA,DIE,DR
S LOC=0 F S LOC=$O(^ECJ("AP",LOC)) Q:'+LOC S CAT="" F S CAT=$O(^ECJ("AP",LOC,ECIEN,CAT)) Q:CAT="" S PROC="" F S PROC=$O(^ECJ("AP",LOC,ECIEN,CAT,PROC)) Q:PROC="" D
.S DA=$O(^ECJ("AP",LOC,ECIEN,CAT,PROC,0)) Q:'+DA
.S DIE="^ECJ("
.S DR="55///@"
.D ^DIE
Q
;
FIXSCRNS ;131 Section added to inactivate existing event code screens
;when category changed from yes to no. Equivalent event code screens
;without a category will either be reactivated or created, as needed
;
N LOC,CAT,PROC,DR,DA,DIE,DSS,ECCH,ECL,ECD,ECC,ECP,ECST,ECSYN,ECVOL,ECAC,ECREAS,NODE
S LOC=0 F S LOC=$O(^ECJ("AP",LOC)) Q:'+LOC S CAT=0 F S CAT=$O(^ECJ("AP",LOC,ECIEN,CAT)) Q:'+CAT S PROC="" F S PROC=$O(^ECJ("AP",LOC,ECIEN,CAT,PROC)) Q:PROC="" D
.S DA=$O(^ECJ("AP",LOC,ECIEN,CAT,PROC,0)) Q:'+DA ;Get record # of existing event code screen
.I $P(^ECJ(DA,0),U,2)'="" Q ;Screen is already inactive, no action needed
.S DIE="^ECJ(",DR="1///"_$$DT^XLFDT D ^DIE ;Inactivate screen using today's date
.;Create or activate/update equivalent event code screen without a category
.S ECCH=LOC_"-"_ECIEN_"-"_0_"-"_PROC,DSS=ECIEN S ECIEN="" ;protecting ECIEN as it's used in another routine
.I $D(^ECJ("B",ECCH)) S ECIEN=$O(^ECJ("B",ECCH,0)) Q:'+ECIEN ;Non-category event code screen exists, identify record number for updating
.S ECL=LOC,ECD=DSS,ECC=0,ECP=PROC,ECST="A"
.S NODE=$G(^ECJ(DA,"PRO")),ECSYN=$P(NODE,U,2),ECVOL=$P(NODE,U,3),ECAC=$P(NODE,U,4),ECREAS=$E($$GET1^DIQ(720.3,DA,56,"E"),1) ;Setting input variables needed for call to ECMFECS
.D FILE^ECMFECS ;File update or create new event code screen
.S ECIEN=DSS ;Reset ECIEN to DSS Unit IEN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECMFDSSU 9547 printed Dec 13, 2024@01:57:38 Page 2
ECMFDSSU ;ALB/JAM-Event Capture Management Filer DSS Unit ;2/6/18 14:41
+1 ;;2.0;EVENT CAPTURE ;**25,30,33,126,131,139**;8 May 96;Build 7
+2 ;
FILE ;Used by the RPC broker to file DSS Units in file #724
+1 ; Variables passed in
+2 ; ECIEN - IEN of #724, if editing
+3 ; ECDUNM - DSS Unit Name
+4 ; ECS - Service
+5 ; ECM - Medical Speciality
+6 ; ECTR - Cost Center
+7 ; ECUN - Unit Number
+8 ; ECST - Status Flag (Active/Inactive)
+9 ; ECASC - Associated Stop Code
+10 ; ECC - Category
+11 ; ECDFDT - Default Data Entry Date
+12 ; ECPCE - Send to PCE
+13 ; ECSCN - Event Code Screens status
+14 ; ECCSC - Credit stop code, can be used when PCE status is
+15 ; no records
+16 ; ECHAR4 - CHAR4 code, can be used when PCE status is no records
+17 ; ECADUP - DSS Unit allows duplicate records during upload
+18 ;
+19 ; Variable return
+20 ; ^TMP($J,"ECMSG",n)=Success or failure to file in #724^Message
+21 ;
+22 NEW ECERR,ECX,ECFLG,ECRES,ECONAM
+23 SET ECERR=0
DO CHKDT
IF ECERR
QUIT
+24 DO VALDATA
IF ECERR
QUIT
+25 SET ECIEN=$GET(ECIEN)
SET ECFLG=1
SET ECONAM=""
SET ECC=$SELECT(ECC="Y":1,1:0)
+26 IF ECIEN'=""
SET ECFLG=0
Begin DoDot:1
+27 IF '$DATA(^ECD(ECIEN,0))
Begin DoDot:2
+28 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^DSS Unit Not on File"
QUIT
End DoDot:2
QUIT
+29 DO CATCHK^ECUMRPC1(.ECRES,ECIEN)
IF ECRES
IF ECC'=$PIECE(^ECD(ECIEN,0),U,11)
Begin DoDot:2
+30 ;131 If Category changed to no, update existing event code screens
IF ECC=0
DO FIXSCRNS
QUIT
+31 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Category Changed, EC Screen exist"
End DoDot:2
+32 SET ECONAM=$PIECE($GET(^ECD(ECIEN,0)),U)
End DoDot:1
IF ECERR
DO END
QUIT
+33 ;Check name
Begin DoDot:1
+34 IF (ECFLG)!((ECONAM'="")&(ECONAM'=ECDUNM))
IF $DATA(^ECD("B",ECDUNM))
Begin DoDot:2
+35 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^DSS Unit Name already exist"
End DoDot:2
QUIT
+36 IF 'ECFLG
KILL DIE
SET DIE="^ECD("
SET DA=ECIEN
SET DR=".01////"_ECDUNM
DO ^DIE
End DoDot:1
IF ECERR
DO END
QUIT
+37 ;139
SET ECPCE=$SELECT(ECPCE="A":"A",ECPCE="OOS":"OOS",1:"N")
+38 ;139
IF ECPCE'="A"
IF $GET(ECASC)=""
Begin DoDot:1
+39 ;126,139 Corrected error message
SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^No associated stop code, send to PCE setting requires an associated stop code"
End DoDot:1
DO END
QUIT
+40 ;131,139 If existing DSS Unit and PCE is changing from All records then update related EC screens
IF 'ECFLG
IF ECPCE'="A"
IF $PIECE($GET(^ECD(+$GET(ECIEN),0)),U,14)="A"
DO UPDSCRN
+41 IF ECIEN=""
DO NEWIEN
+42 KILL DA,DR,DIE
+43 SET ECST=$EXTRACT($GET(ECST))
SET ECST=$SELECT(ECST="I":1,1:0)
SET ECDFDT=$EXTRACT($GET(ECDFDT))
+44 SET ECDFDT=$SELECT(ECDFDT="N":"N",1:"X")
SET DIE="^ECD("
SET DA=ECIEN
+45 SET DR="1////"_ECS_";2////"_ECM_";3////"_ECTR_";4////"_$GET(ECUN)
+46 ;139
SET DR=DR_";5////"_ECST_";7////1;9////"_$SELECT(ECPCE="A":"@",1:$GET(ECASC))
+47 SET DR=DR_";10////"_ECC_";11////"_ECDFDT_";13////"_ECPCE
+48 ;126,139 Add credit stop and char4 fields, 139 Update logic for deleting stop code
SET DR=DR_";14////"_$SELECT(ECPCE="A":"@",$GET(ECCSC)="":"@",1:$GET(ECCSC))_";15////"_$SELECT(ECPCE'="N":"@",$GET(ECHAR4)="":"@",1:$GET(ECHAR4))
+49 ;139 Does DSS Unit allow duplicate records to be uploaded
SET DR=DR_";16////"_$GET(ECADUP,"N")
+50 DO ^DIE
IF $DATA(DTOUT)
DO RECDEL
Begin DoDot:1
+51 SET ^TMP($JOB,"ECMSG",1)="0^DSS Unit Record not Filed"
End DoDot:1
DO END
QUIT
+52 IF 'ECFLG
DO ECSCRNS
+53 SET ^TMP($JOB,"ECMSG",1)="1^DSS Unit Record Filed"_U_ECIEN
END KILL DIE,DIC,DR,DA,DO,ECIEN
+1 QUIT
VALDATA ;validate data
+1 NEW ECRRX
+2 DO CHK^DIE(724,.01,"E",ECDUNM,.ECRRX)
IF ECRRX'=ECDUNM
Begin DoDot:1
+3 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid DSS Unit Name"
End DoDot:1
QUIT
+4 DO CHK^DIE(724,1,"E","`"_ECS,.ECRRX)
IF ECRRX'=ECS
Begin DoDot:1
+5 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid Service"
End DoDot:1
QUIT
+6 DO CHK^DIE(724,2,"E","`"_ECM,.ECRRX)
IF ECRRX'=ECM
Begin DoDot:1
+7 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid Medical Speciality"
End DoDot:1
QUIT
+8 DO CHK^DIE(724,3,"E","`"_ECTR,.ECRRX)
IF ECRRX'=ECTR
Begin DoDot:1
+9 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid Cost Center"
End DoDot:1
QUIT
+10 IF $GET(ECUN)'=""
DO CHK^DIE(724,4,"E",ECUN,.ECRRX)
IF ECRRX'=ECUN
Begin DoDot:1
+11 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid Unit Number"
End DoDot:1
QUIT
+12 IF $GET(ECASC)'=""
DO CHK^DIE(724,9,"E","`"_ECASC,.ECRRX)
IF ECRRX'=ECASC
Begin DoDot:1
+13 ;126 Corrected error message
SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid Associated Stop Code"
End DoDot:1
QUIT
+14 ;126
IF $GET(ECCSC)'=""
DO CHK^DIE(724,14,"E","`"_ECCSC,.ECRRX)
IF ECRRX'=ECCSC
SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid Credit Stop Code"
QUIT
+15 ;126
IF $GET(ECHAR4)'=""
DO CHK^DIE(724,15,"E","`"_ECHAR4,.ECRRX)
IF ECRRX'=ECHAR4
SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Invalid CHAR4 Code"
QUIT
+16 QUIT
ECSCRNS ;Determine if event codes should be updated based on change of DSS Unit
+1 ;status
+2 ; DSS Unit status changed from Active to Inactive, if EC screen status
+3 ; A - retain, do nothing, B - inactiviate
+4 ; DSS Unit status changed from Inactive to Active, if EC screen status
+5 ; C - reactiviate, D - remain inactive
+6 ;
+7 NEW ECD,ECINC,ZTDESC,ZTSAVE,ZTIO,ZTRTN,ZTDTH
+8 IF ($GET(ECSCN)="")!(ECSCN="A")!(ECSCN="D")
QUIT
+9 IF "^B^C^"']"^"_ECSCN_"^"
QUIT
+10 SET ECD=ECIEN
SET ECINC=DT
+11 IF ECSCN="B"
Begin DoDot:1
+12 SET ZTDESC="DEALLOCATE DSS UNIT & INACTIVATE EVENT CODE SCREENS"
End DoDot:1
+13 IF ECSCN="C"
Begin DoDot:1
+14 SET ZTDESC="REACTIVIATE EVENT CODE SCREENS"
SET ECINC="@"
End DoDot:1
+15 SET ZTRTN=$SELECT(ECSCN="B":"DIK",1:"INSCRN")_"^ECDEAL"
SET ZTDTH=$HOROLOG
+16 NEW ECSCN
+17 SET ECSCN=1
SET (ZTSAVE("ECD"),ZTSAVE("ECSCN"),ZTSAVE("ECINC"))=""
SET ZTIO=""
+18 DO ^%ZTLOAD
KILL ZTSK
QUIT
+19 DO @ZTRTN
+20 QUIT
+21 ;
RECDEL ; Delete record
+1 IF ECFLG
SET DA=ECIEN
SET DIK="^ECD("
DO ^DIK
KILL DA,DIK
+2 QUIT
NEWIEN ;Create new IEN in file #724
+1 NEW DIC,DA,DD,DO
+2 ;126 Added lock time out as required by standard
LOCK +^ECD(0):3
+3 SET DIC=724
SET DIC(0)="L"
SET X=ECDUNM
+4 DO FILE^DICN
+5 LOCK -^ECD(0)
+6 SET ECIEN=+Y
+7 QUIT
CHKDT ;Required Data Check
+1 NEW I,C
+2 SET C=1
+3 FOR I="ECDUNM","ECS","ECM","ECTR","ECC"
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
USER ;Used by the RPC broker to allocate or de-allocate users for DSS Units
+1 ;in file #200
+2 ; Variables passed in
+3 ; ECIEN - IEN of DSS Unit in file #724
+4 ; ECUSR0..n - Users to allocate/deallocate to DSS Unit
+5 ;
+6 ; Variable return
+7 ; ^TMP($J,"ECMSG",n)=Success or failure to file in #724^Message
+8 ;
+9 NEW EDUZ,ECERR,ECI,ECX,USER,DIC,DIK,X,Y,DA
+10 SET (EDUZ,ECERR)=0
SET ECIEN=$GET(ECIEN)
+11 IF ECIEN=""
SET ^TMP($JOB,"ECMSG",1)="0^DSS Unit missing"
QUIT
+12 Begin DoDot:1
+13 IF '$DATA(^ECD(ECIEN,0))
Begin DoDot:2
+14 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^DSS Unit Not on File"
End DoDot:2
End DoDot:1
IF ECERR
QUIT
+15 FOR ECI=0:1
SET ECX="ECUSR"_ECI
if '$DATA(@ECX)
QUIT
if @ECX'=""
SET USER(@ECX)=""
+16 FOR
SET EDUZ=$ORDER(^VA(200,EDUZ))
if 'EDUZ
QUIT
IF $DATA(^VA(200,EDUZ,"EC",ECIEN,0))
Begin DoDot:1
+17 IF $DATA(USER(EDUZ))
KILL USER(EDUZ)
QUIT
+18 KILL DA,DIK
SET DA(1)=EDUZ
SET DA=ECIEN
SET DIK="^VA(200,"_DA(1)_",""EC"","
+19 DO ^DIK
KILL USER(EDUZ)
End DoDot:1
+20 ;add users for DSS Unit
+21 SET EDUZ=0
FOR
SET EDUZ=$ORDER(USER(EDUZ))
if 'EDUZ
QUIT
Begin DoDot:1
+22 KILL DIC,DD,DO
SET DIC=200
SET DIC(0)="QNMX"
SET X=EDUZ
DO ^DIC
IF Y<0
QUIT
+23 KILL DIC,DD,DO
SET DIC(0)="L"
SET DA(1)=EDUZ
SET DIC("P")=$PIECE(^DD(200,720,0),U,2)
+24 SET DINUM=ECIEN
SET DIC="^VA(200,"_DA(1)_",""EC"","
SET X=ECIEN
+25 DO FILE^DICN
End DoDot:1
+26 SET ^TMP($JOB,"ECMSG",1)="1^Record Filed"_U_ECIEN
KILL DINUM
+27 QUIT
DSSU ;Used by the RPC broker to allocate or de-allocate DSS Units for a user
+1 ;in file #200
+2 ; Variables passed in
+3 ; ECIEN - User IEN in file #200
+4 ; ECD0..n - IEN of DSS Unit in file #724 to allocate/deallocate
+5 ;
+6 ;
+7 ; Variable return
+8 ; ^TMP($J,"ECMSG",n)=Success or failure to file in #200^Message
+9 ;
+10 NEW EDU,ECERR,ECI,ECX,ECDSSU,DIC,DIK,DA,X,Y
+11 SET (EDU,ECERR)=0
SET ECIEN=$GET(ECIEN)
+12 IF ECIEN=""
SET ^TMP($JOB,"ECMSG",1)="0^User missing"
QUIT
+13 Begin DoDot:1
+14 SET DIC=200
SET DIC(0)="QNX"
SET X=ECIEN
DO ^DIC
if Y<0
Begin DoDot:2
+15 SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^User Not on File"
End DoDot:2
End DoDot:1
IF ECERR
QUIT
+16 FOR ECI=0:1
SET ECX="ECD"_ECI
if '$DATA(@ECX)
QUIT
if @ECX'=""
SET ECDSSU(@ECX)=""
+17 FOR
SET EDU=$ORDER(^VA(200,ECIEN,"EC",EDU))
if 'EDU
QUIT
Begin DoDot:1
+18 IF $DATA(ECDSSU(EDU))
KILL ECDSSU(EDU)
QUIT
+19 KILL DA,DIK
SET DA(1)=ECIEN
SET DA=EDU
SET DIK="^VA(200,"_DA(1)_",""EC"","
+20 DO ^DIK
End DoDot:1
+21 ;add DSS Units for user
+22 SET EDU=0
FOR
SET EDU=$ORDER(ECDSSU(EDU))
if 'EDU
QUIT
Begin DoDot:1
+23 IF '$DATA(^ECD(EDU,0))
QUIT
+24 KILL DIC,DD,DO
SET DIC(0)="L"
SET DA(1)=ECIEN
SET DIC("P")=$PIECE(^DD(200,720,0),U,2)
+25 SET DINUM=EDU
SET DIC="^VA(200,"_DA(1)_",""EC"","
SET X=EDU
+26 DO FILE^DICN
End DoDot:1
+27 SET ^TMP($JOB,"ECMSG",1)="1^Record Filed"_U_ECIEN
+28 QUIT
+29 ;
UPDSCRN ;131 Section added to remove default associated clinic from event capture screens for a specific DSS Unit
+1 NEW LOC,CAT,PROC,DA,DIE,DR
+2 SET LOC=0
FOR
SET LOC=$ORDER(^ECJ("AP",LOC))
if '+LOC
QUIT
SET CAT=""
FOR
SET CAT=$ORDER(^ECJ("AP",LOC,ECIEN,CAT))
if CAT=""
QUIT
SET PROC=""
FOR
SET PROC=$ORDER(^ECJ("AP",LOC,ECIEN,CAT,PROC))
if PROC=""
QUIT
Begin DoDot:1
+3 SET DA=$ORDER(^ECJ("AP",LOC,ECIEN,CAT,PROC,0))
if '+DA
QUIT
+4 SET DIE="^ECJ("
+5 SET DR="55///@"
+6 DO ^DIE
End DoDot:1
+7 QUIT
+8 ;
FIXSCRNS ;131 Section added to inactivate existing event code screens
+1 ;when category changed from yes to no. Equivalent event code screens
+2 ;without a category will either be reactivated or created, as needed
+3 ;
+4 NEW LOC,CAT,PROC,DR,DA,DIE,DSS,ECCH,ECL,ECD,ECC,ECP,ECST,ECSYN,ECVOL,ECAC,ECREAS,NODE
+5 SET LOC=0
FOR
SET LOC=$ORDER(^ECJ("AP",LOC))
if '+LOC
QUIT
SET CAT=0
FOR
SET CAT=$ORDER(^ECJ("AP",LOC,ECIEN,CAT))
if '+CAT
QUIT
SET PROC=""
FOR
SET PROC=$ORDER(^ECJ("AP",LOC,ECIEN,CAT,PROC))
if PROC=""
QUIT
Begin DoDot:1
+6 ;Get record # of existing event code screen
SET DA=$ORDER(^ECJ("AP",LOC,ECIEN,CAT,PROC,0))
if '+DA
QUIT
+7 ;Screen is already inactive, no action needed
IF $PIECE(^ECJ(DA,0),U,2)'=""
QUIT
+8 ;Inactivate screen using today's date
SET DIE="^ECJ("
SET DR="1///"_$$DT^XLFDT
DO ^DIE
+9 ;Create or activate/update equivalent event code screen without a category
+10 ;protecting ECIEN as it's used in another routine
SET ECCH=LOC_"-"_ECIEN_"-"_0_"-"_PROC
SET DSS=ECIEN
SET ECIEN=""
+11 ;Non-category event code screen exists, identify record number for updating
IF $DATA(^ECJ("B",ECCH))
SET ECIEN=$ORDER(^ECJ("B",ECCH,0))
if '+ECIEN
QUIT
+12 SET ECL=LOC
SET ECD=DSS
SET ECC=0
SET ECP=PROC
SET ECST="A"
+13 ;Setting input variables needed for call to ECMFECS
SET NODE=$GET(^ECJ(DA,"PRO"))
SET ECSYN=$PIECE(NODE,U,2)
SET ECVOL=$PIECE(NODE,U,3)
SET ECAC=$PIECE(NODE,U,4)
SET ECREAS=$EXTRACT($$GET1^DIQ(720.3,DA,56,"E"),1)
+14 ;File update or create new event code screen
DO FILE^ECMFECS
+15 ;Reset ECIEN to DSS Unit IEN
SET ECIEN=DSS
End DoDot:1
+16 QUIT
