- 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 Apr 23, 2025@18:12:06 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
