ECMDDSSU ;ALB/CMD - Event Capture Management Delete Unused DSS Unit ;12/22/21 10:43
;;2.0;EVENT CAPTURE ;**156**;8 May 96;Build 28
;
; Reference to $$CPT^ICPTCOD supported by ICR #1995
; Reference to $$GET1^DIQ supported by ICR #2056
; Reference to $$REPEAT^XLFSTR supported by ICR #10104
; Reference to ^XMD supported by ICR #10070
; Reference to ^DIK supported by ICR #10013
; Reference to ^VA(200 supported by ICR #10060
; Reference to ^TMP supported by SACC 2.3.2.5.1
;
DELDSS ;Used by the RPC broker to delete unused DSS Unit in file #724
; Variable passed in:
; ECIEN - IEN of #724
; ECDUZ - User IEN of #200
; Variable return
; ^TMP($J,"ECMSG",n)=Success or failure to remove entries in #724^Message
;
N ARRFND,DIK,DA,DIE,ECARR,ECDECS,GREF,FOUND,ECERR,ECFILE,ECUSR,DSSUSR,ECSIEN,DSSIEN,CNT
S ECERR=0
D CHKDT^ECMDECS I ECERR Q
S DSSIEN=ECIEN
S GREF="^ECH(""ADT"")",FOUND=0
F S GREF=$Q(@GREF) Q:$QS(GREF,1)'="ADT" D Q:FOUND
. I $QS(GREF,4)=DSSIEN S FOUND=1,ARRFND($QS(GREF,2),$QS(GREF,3),$QS(GREF,4))=""
I FOUND S ECERR=1,^TMP($J,"ECMSG",1)="0^DSS Unit had workload"_U_$G(ECIEN) Q
I 'FOUND D ECHKSCR(DSSIEN,.ECDECS) Q:ECERR
I '$D(ECDECS) S ECERR=1,^TMP($J,"ECMSG",1)="0^DSS Unit had workload on its Event Code Screens" Q
D ECUSR^ECUMRPC(.DSSURES,DSSIEN)
M DSSUSR=@DSSURES
S CNT=0
F CNT=$O(DSSUSR(CNT)) Q:'CNT S ECUSR($P(DSSUSR(CNT),U,2))=""
D DSSUSRDE(DSSIEN,.ECUSR) ;Deallocate users to DSS Unit
I $D(ECDECS) D SENDMM(.ECDECS) ;Send MM to list DSS unit and its EC Screen to be deleted
S ECSIEN=""
F S ECSIEN=$O(ECDECS(DSSIEN,ECSIEN)) Q:ECSIEN="" D
. S DIK="^ECJ(",DA=ECSIEN D ^DIK
S DIK="^ECD(",DA=DSSIEN D ^DIK
S ^TMP($J,"ECMSG",1)="1^DSS Unit Deleted"_U_$G(ECIEN)
D KILLVAR^ECFLRPC
K ^TMP($J,"ECUSR")
S RESULTS=$NA(^TMP($J,"ECMSG"))
Q
;
ECHKSCR(DSSUNT,DELECS) ;
;Get all EC Screen for the DSS Unit
;Check them again before delete EC screeens and DSS Unit
N GLBREF,ECLOC,ECCAT,ECPROC,ECSCR,ECSOK
S GLBREF="^ECJ(""AP"")"
S ECSOK=1
F S GLBREF=$Q(@GLBREF) Q:$QS(GLBREF,1)'="AP" D
.I $QS(GLBREF,3)'=DSSUNT Q
.S ECCAT=$QS(GLBREF,4),ECPROC=$QS(GLBREF,5),ECLOC=$QS(GLBREF,2),ECSCR=$QS(GLBREF,6)
.S ECSOK=1 D CHKWRK(ECSCR,.ECSOK)
.I ECSOK S DELECS(DSSUNT,ECSCR)=""
I ECSOK,'$D(DELECS) S DELECS(DSSUNT,0)=""
Q
;
CHKWRK(ECIEN,DELOK) ;
N ECREC,ECSCR,ECL,ECD,ECC,ECCAT,ECP,ECHIEN,ECPROC
N ARRFND,GREF,STR
S ECSCR=$$GET1^DIQ(720.3,ECIEN,".01","I")
S ECL=$P(ECSCR,"-"),ECD=$P(ECSCR,"-",2),ECC=$P(ECSCR,"-",3),ECP=$P(ECSCR,"-",4)
I ECC="" S ECC=0
S GREF="^ECH(""ADT"",ECL)"
S STR=ECL_"-"_ECD_"-"_ECC_"-"_ECP
F S GREF=$Q(@GREF) Q:$QS(GREF,1)'["ADT" Q:$QS(GREF,2)'=ECL D Q:'DELOK
. I $QS(GREF,4)'=ECD Q
. S ECHIEN=$QS(GREF,6)
. S ECREC=^ECH(ECHIEN,0)
. S ECCAT=$P(ECREC,U,8),ECPROC=$P(ECREC,U,9)
. I (ECCAT=ECC),(ECPROC=ECP) D Q:'DELOK
.. S ARRFND(STR,ECHIEN)=ECIEN
.. S DELOK=0
Q
DSSUSRDE(DSSUNT,USRARR) ;Deallocate Users to DSS Unit
N EDUZ,DIK,X,Y,DA
S EDUZ=0
F S EDUZ=$O(^VA(200,EDUZ)) Q:'EDUZ I $D(^VA(200,EDUZ,"EC",DSSUNT,0)) D
. I '$D(USRARR(EDUZ)) Q
. K DA,DIK S DA(1)=EDUZ,DA=DSSUNT,DIK="^VA(200,"_DA(1)_",""EC"","
. D ^DIK K USRARR(EDUZ)
Q
;
SENDMM(ECSARR) ;Send Mailman message
N ECMSG,ECTEXT,XMSUB,XMY,XMTEXT,XMDUZ,CNT,SCRSTAT,SYN,LOC,LOCDS,DEFCL,DSSREC,DSS,DSSU,DSSNM
N INACTDT,PN,PRO,PROC,ECREC,ECSCR,ECPI,SCR,CAT,CATD,IEN
S XMSUB="DELETION OF UNUSED DSS UNIT FROM FILE #724",XMDUZ="EVENT CAPTURE PACKAGE"
S XMTEXT="ECTEXT("
D GETXMY^ECMDECS("ECMGR",.XMY)
S CNT=1,SCR=""
S DSS=$O(ECSARR(""))
S DSSREC=^ECD(DSS,0)
S DSSNM=$P(DSSREC,U)
I $O(ECSARR(DSS,0))="" d Q
.S ECTEXT(CNT)="The following DSS Unit has been deleted, it had no workload associated with it.",CNT=CNT+1
.S ECTEXT(CNT)="This DSS Unit had no Event Code Screens associated with it.",CNT=CNT+1
.S ECTEXT(CNT)=" ",CNT=CNT+1
.S ECTEXT(CNT)="DSS UNIT: "_$$GET1^DIQ(724,DSS,.01,"E")_" ("_DSS_")",CNT=CNT+1
.S ECTEXT(CNT)=" ",CNT=CNT+1
.D ^XMD
S ECTEXT(CNT)="The following DSS Unit and its associated Event Code Screens have been deleted,",CNT=CNT+1
S ECTEXT(CNT)="it had no workload associated with it.",CNT=CNT+1
S ECTEXT(CNT)=" ",CNT=CNT+1
S ECTEXT(CNT)="DSS UNIT: "_$$GET1^DIQ(724,DSS,.01,"E")_" ("_DSS_")",CNT=CNT+1
S ECTEXT(CNT)=" ",CNT=CNT+1
F S SCR=$O(ECSARR(DSS,SCR)) Q:SCR="" D
.S ECREC=^ECJ(SCR,0),ECSCR=$P(ECREC,U),INACTDT=$P(ECREC,U,2)
.S DSSU=$P(ECSCR,"-",2),LOC=$P(ECSCR,"-"),CAT=$P(ECSCR,"-",3)
.S PRO=$G(^ECJ(SCR,"PRO")),SYN=$P(PRO,U,2),PROC=$P($P(PRO,U),";"),DEFCL=+$P(PRO,U,4),PRO=$P(PRO,U)
.I PRO["EC" S PN=$G(^EC(725,PROC,0)),PROC=$P(PN,U,2)_" "_$P(PN,U)
.I PRO["ICPT" S ECPI=$$CPT^ICPTCOD(+PRO) I +ECPI>0 D
.. S PROC=$P(ECPI,U,3)_" ("_$P(ECPI,U,2)_")"
.S SCRSTAT=$S(INACTDT'="":"Inactve",1:"Active")
.S CATD=$S('CAT:"None",1:$P($G(^EC(726,CAT,0)),U))
.S LOCDS=$$GET1^DIQ(4,LOC,.01,"E")
.S ECTEXT(CNT)=" LOC: "_LOCDS_$$REPEAT^XLFSTR(" ",(27-$L(LOCDS)))_"PROC: "_PROC,CNT=CNT+1
.S ECTEXT(CNT)=" CAT: "_CATD_$$REPEAT^XLFSTR(" ",(27-$L(CATD)))_"SYN: "_SYN,CNT=CNT+1
.S ECTEXT(CNT)=" DEFAULT ASSOCIATED CLINIC: "_$$GET1^DIQ(44,DEFCL,.01,"E"),CNT=CNT+1
.S ECTEXT(CNT)=" STATUS: "_SCRSTAT,CNT=CNT+1
.S ECTEXT(CNT)=" ",CNT=CNT+1
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECMDDSSU 5285 printed Dec 13, 2024@01:57:35 Page 2
ECMDDSSU ;ALB/CMD - Event Capture Management Delete Unused DSS Unit ;12/22/21 10:43
+1 ;;2.0;EVENT CAPTURE ;**156**;8 May 96;Build 28
+2 ;
+3 ; Reference to $$CPT^ICPTCOD supported by ICR #1995
+4 ; Reference to $$GET1^DIQ supported by ICR #2056
+5 ; Reference to $$REPEAT^XLFSTR supported by ICR #10104
+6 ; Reference to ^XMD supported by ICR #10070
+7 ; Reference to ^DIK supported by ICR #10013
+8 ; Reference to ^VA(200 supported by ICR #10060
+9 ; Reference to ^TMP supported by SACC 2.3.2.5.1
+10 ;
DELDSS ;Used by the RPC broker to delete unused DSS Unit in file #724
+1 ; Variable passed in:
+2 ; ECIEN - IEN of #724
+3 ; ECDUZ - User IEN of #200
+4 ; Variable return
+5 ; ^TMP($J,"ECMSG",n)=Success or failure to remove entries in #724^Message
+6 ;
+7 NEW ARRFND,DIK,DA,DIE,ECARR,ECDECS,GREF,FOUND,ECERR,ECFILE,ECUSR,DSSUSR,ECSIEN,DSSIEN,CNT
+8 SET ECERR=0
+9 DO CHKDT^ECMDECS
IF ECERR
QUIT
+10 SET DSSIEN=ECIEN
+11 SET GREF="^ECH(""ADT"")"
SET FOUND=0
+12 FOR
SET GREF=$QUERY(@GREF)
if $QSUBSCRIPT(GREF,1)'="ADT"
QUIT
Begin DoDot:1
+13 IF $QSUBSCRIPT(GREF,4)=DSSIEN
SET FOUND=1
SET ARRFND($QSUBSCRIPT(GREF,2),$QSUBSCRIPT(GREF,3),$QSUBSCRIPT(GREF,4))=""
End DoDot:1
if FOUND
QUIT
+14 IF FOUND
SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^DSS Unit had workload"_U_$GET(ECIEN)
QUIT
+15 IF 'FOUND
DO ECHKSCR(DSSIEN,.ECDECS)
if ECERR
QUIT
+16 IF '$DATA(ECDECS)
SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^DSS Unit had workload on its Event Code Screens"
QUIT
+17 DO ECUSR^ECUMRPC(.DSSURES,DSSIEN)
+18 MERGE DSSUSR=@DSSURES
+19 SET CNT=0
+20 FOR CNT=$ORDER(DSSUSR(CNT))
if 'CNT
QUIT
SET ECUSR($PIECE(DSSUSR(CNT),U,2))=""
+21 ;Deallocate users to DSS Unit
DO DSSUSRDE(DSSIEN,.ECUSR)
+22 ;Send MM to list DSS unit and its EC Screen to be deleted
IF $DATA(ECDECS)
DO SENDMM(.ECDECS)
+23 SET ECSIEN=""
+24 FOR
SET ECSIEN=$ORDER(ECDECS(DSSIEN,ECSIEN))
if ECSIEN=""
QUIT
Begin DoDot:1
+25 SET DIK="^ECJ("
SET DA=ECSIEN
DO ^DIK
End DoDot:1
+26 SET DIK="^ECD("
SET DA=DSSIEN
DO ^DIK
+27 SET ^TMP($JOB,"ECMSG",1)="1^DSS Unit Deleted"_U_$GET(ECIEN)
+28 DO KILLVAR^ECFLRPC
+29 KILL ^TMP($JOB,"ECUSR")
+30 SET RESULTS=$NAME(^TMP($JOB,"ECMSG"))
+31 QUIT
+32 ;
ECHKSCR(DSSUNT,DELECS) ;
+1 ;Get all EC Screen for the DSS Unit
+2 ;Check them again before delete EC screeens and DSS Unit
+3 NEW GLBREF,ECLOC,ECCAT,ECPROC,ECSCR,ECSOK
+4 SET GLBREF="^ECJ(""AP"")"
+5 SET ECSOK=1
+6 FOR
SET GLBREF=$QUERY(@GLBREF)
if $QSUBSCRIPT(GLBREF,1)'="AP"
QUIT
Begin DoDot:1
+7 IF $QSUBSCRIPT(GLBREF,3)'=DSSUNT
QUIT
+8 SET ECCAT=$QSUBSCRIPT(GLBREF,4)
SET ECPROC=$QSUBSCRIPT(GLBREF,5)
SET ECLOC=$QSUBSCRIPT(GLBREF,2)
SET ECSCR=$QSUBSCRIPT(GLBREF,6)
+9 SET ECSOK=1
DO CHKWRK(ECSCR,.ECSOK)
+10 IF ECSOK
SET DELECS(DSSUNT,ECSCR)=""
End DoDot:1
+11 IF ECSOK
IF '$DATA(DELECS)
SET DELECS(DSSUNT,0)=""
+12 QUIT
+13 ;
CHKWRK(ECIEN,DELOK) ;
+1 NEW ECREC,ECSCR,ECL,ECD,ECC,ECCAT,ECP,ECHIEN,ECPROC
+2 NEW ARRFND,GREF,STR
+3 SET ECSCR=$$GET1^DIQ(720.3,ECIEN,".01","I")
+4 SET ECL=$PIECE(ECSCR,"-")
SET ECD=$PIECE(ECSCR,"-",2)
SET ECC=$PIECE(ECSCR,"-",3)
SET ECP=$PIECE(ECSCR,"-",4)
+5 IF ECC=""
SET ECC=0
+6 SET GREF="^ECH(""ADT"",ECL)"
+7 SET STR=ECL_"-"_ECD_"-"_ECC_"-"_ECP
+8 FOR
SET GREF=$QUERY(@GREF)
if $QSUBSCRIPT(GREF,1)'["ADT"
QUIT
if $QSUBSCRIPT(GREF,2)'=ECL
QUIT
Begin DoDot:1
+9 IF $QSUBSCRIPT(GREF,4)'=ECD
QUIT
+10 SET ECHIEN=$QSUBSCRIPT(GREF,6)
+11 SET ECREC=^ECH(ECHIEN,0)
+12 SET ECCAT=$PIECE(ECREC,U,8)
SET ECPROC=$PIECE(ECREC,U,9)
+13 IF (ECCAT=ECC)
IF (ECPROC=ECP)
Begin DoDot:2
+14 SET ARRFND(STR,ECHIEN)=ECIEN
+15 SET DELOK=0
End DoDot:2
if 'DELOK
QUIT
End DoDot:1
if 'DELOK
QUIT
+16 QUIT
DSSUSRDE(DSSUNT,USRARR) ;Deallocate Users to DSS Unit
+1 NEW EDUZ,DIK,X,Y,DA
+2 SET EDUZ=0
+3 FOR
SET EDUZ=$ORDER(^VA(200,EDUZ))
if 'EDUZ
QUIT
IF $DATA(^VA(200,EDUZ,"EC",DSSUNT,0))
Begin DoDot:1
+4 IF '$DATA(USRARR(EDUZ))
QUIT
+5 KILL DA,DIK
SET DA(1)=EDUZ
SET DA=DSSUNT
SET DIK="^VA(200,"_DA(1)_",""EC"","
+6 DO ^DIK
KILL USRARR(EDUZ)
End DoDot:1
+7 QUIT
+8 ;
SENDMM(ECSARR) ;Send Mailman message
+1 NEW ECMSG,ECTEXT,XMSUB,XMY,XMTEXT,XMDUZ,CNT,SCRSTAT,SYN,LOC,LOCDS,DEFCL,DSSREC,DSS,DSSU,DSSNM
+2 NEW INACTDT,PN,PRO,PROC,ECREC,ECSCR,ECPI,SCR,CAT,CATD,IEN
+3 SET XMSUB="DELETION OF UNUSED DSS UNIT FROM FILE #724"
SET XMDUZ="EVENT CAPTURE PACKAGE"
+4 SET XMTEXT="ECTEXT("
+5 DO GETXMY^ECMDECS("ECMGR",.XMY)
+6 SET CNT=1
SET SCR=""
+7 SET DSS=$ORDER(ECSARR(""))
+8 SET DSSREC=^ECD(DSS,0)
+9 SET DSSNM=$PIECE(DSSREC,U)
+10 IF $ORDER(ECSARR(DSS,0))=""
Begin DoDot:1
+11 SET ECTEXT(CNT)="The following DSS Unit has been deleted, it had no workload associated with it."
SET CNT=CNT+1
+12 SET ECTEXT(CNT)="This DSS Unit had no Event Code Screens associated with it."
SET CNT=CNT+1
+13 SET ECTEXT(CNT)=" "
SET CNT=CNT+1
+14 SET ECTEXT(CNT)="DSS UNIT: "_$$GET1^DIQ(724,DSS,.01,"E")_" ("_DSS_")"
SET CNT=CNT+1
+15 SET ECTEXT(CNT)=" "
SET CNT=CNT+1
+16 DO ^XMD
End DoDot:1
QUIT
+17 SET ECTEXT(CNT)="The following DSS Unit and its associated Event Code Screens have been deleted,"
SET CNT=CNT+1
+18 SET ECTEXT(CNT)="it had no workload associated with it."
SET CNT=CNT+1
+19 SET ECTEXT(CNT)=" "
SET CNT=CNT+1
+20 SET ECTEXT(CNT)="DSS UNIT: "_$$GET1^DIQ(724,DSS,.01,"E")_" ("_DSS_")"
SET CNT=CNT+1
+21 SET ECTEXT(CNT)=" "
SET CNT=CNT+1
+22 FOR
SET SCR=$ORDER(ECSARR(DSS,SCR))
if SCR=""
QUIT
Begin DoDot:1
+23 SET ECREC=^ECJ(SCR,0)
SET ECSCR=$PIECE(ECREC,U)
SET INACTDT=$PIECE(ECREC,U,2)
+24 SET DSSU=$PIECE(ECSCR,"-",2)
SET LOC=$PIECE(ECSCR,"-")
SET CAT=$PIECE(ECSCR,"-",3)
+25 SET PRO=$GET(^ECJ(SCR,"PRO"))
SET SYN=$PIECE(PRO,U,2)
SET PROC=$PIECE($PIECE(PRO,U),";")
SET DEFCL=+$PIECE(PRO,U,4)
SET PRO=$PIECE(PRO,U)
+26 IF PRO["EC"
SET PN=$GET(^EC(725,PROC,0))
SET PROC=$PIECE(PN,U,2)_" "_$PIECE(PN,U)
+27 IF PRO["ICPT"
SET ECPI=$$CPT^ICPTCOD(+PRO)
IF +ECPI>0
Begin DoDot:2
+28 SET PROC=$PIECE(ECPI,U,3)_" ("_$PIECE(ECPI,U,2)_")"
End DoDot:2
+29 SET SCRSTAT=$SELECT(INACTDT'="":"Inactve",1:"Active")
+30 SET CATD=$SELECT('CAT:"None",1:$PIECE($GET(^EC(726,CAT,0)),U))
+31 SET LOCDS=$$GET1^DIQ(4,LOC,.01,"E")
+32 SET ECTEXT(CNT)=" LOC: "_LOCDS_$$REPEAT^XLFSTR(" ",(27-$LENGTH(LOCDS)))_"PROC: "_PROC
SET CNT=CNT+1
+33 SET ECTEXT(CNT)=" CAT: "_CATD_$$REPEAT^XLFSTR(" ",(27-$LENGTH(CATD)))_"SYN: "_SYN
SET CNT=CNT+1
+34 SET ECTEXT(CNT)=" DEFAULT ASSOCIATED CLINIC: "_$$GET1^DIQ(44,DEFCL,.01,"E")
SET CNT=CNT+1
+35 SET ECTEXT(CNT)=" STATUS: "_SCRSTAT
SET CNT=CNT+1
+36 SET ECTEXT(CNT)=" "
SET CNT=CNT+1
End DoDot:1
+37 DO ^XMD
+38 QUIT
