ECMDECS ;ALB/CMD - Event Capture Management Delete EC Screen ;12/10/21 15:06
;;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 ^XUSEC(key) supported by ICR #10076
; Reference to ^DIK supported by ICR #10013
; Reference to ^TMP supported by SACC 2.3.2.5.1
;
DELECSR ;Used by the RPC broker to delete EC Code Sreens in file #720.3
; Variable passed in:
; ECIEN - IEN of #720.3
; ECDUZ - User IEN of #200
; Variable return
; ^TMP($J,"ECMSG",n)=Success or failure to remove entries in #720.3^Message
;
N DIK,DA,ECERR
K ^TMP($J,"ECSCRDEL")
K ^TMP($J,"ECMSG")
S ECERR=0
I ECIEN="" S ECERR=1,^TMP($J,"ECMSG",1)="0^Event Code Screen is missing" Q
D CHKDT I ECERR Q
D CHKWRK(ECIEN) I ECERR Q
D SENDMM(ECIEN) ; Send MailMan message to the holders of ECMGR
S DIK="^ECJ(",DA=ECIEN D ^DIK
S ^TMP($J,"ECMSG",1)="1^Event Code Screen Deleted"_U_$G(ECIEN)
Q
;
CHKDT ;Required Data Check
N I,C
S C=1
F I="ECIEN","ECDUZ" D
.I $G(@I)="" S ^TMP($J,"ECMSG",C)="0^Key data missing "_I,C=C+1,ECERR=1
Q
;
CHKWRK(IEN) ;Check if EC Screen had workload
N ECSCR,ECL,ECD,ECC,ECP,ECCAT,ECHIEN,ECPROC,ECREC
N ARRFND,GREF,STR
S ECSCR=$$GET1^DIQ(720.3,IEN,".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
. 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
.. S ARRFND(STR,ECHIEN)=ECIEN
I $O(ARRFND(STR,"")) S ^TMP($J,"ECMSG",1)="0^Event Code Screen had workload."_U_ECIEN,ECERR=1 Q
Q
SENDMM(IEN) ;
N ECMSG,ECTEXT,XMSUB,XMY,XMTEXT,XMDUZ,CNT,SCRSTAT,SYN,LOC,LOCDS,DEFCL,DSSU,CAT,CATD
N INACTDT,PN,PRO,PROC,ECREC,ECSCR,ECPI
S XMSUB="DELETION OF UNUSED EVENT CODE SCREENS FROM File #720.3",XMDUZ="EVENT CAPTURE PACKAGE"
S XMTEXT="ECTEXT("
D GETXMY("ECMGR",.XMY)
S CNT=1
S ECREC=^ECJ(IEN,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(IEN,"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)_" ("_$P(PN,U,2)_")"
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)="The following Event Code Screen has been deleted, it had no workload",CNT=CNT+1
S ECTEXT(CNT)="associated with it.",CNT=CNT+1
S ECTEXT(CNT)=" ",CNT=CNT+1
S ECTEXT(CNT)="DSS UNIT: "_$$GET1^DIQ(724,DSSU,.01,"E")_" ("_DSSU_")",CNT=CNT+1
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)=""
D ^XMD
Q
GETXMY(KEY,XMY) ;Put holders of the KEY into the XMY array to be recipients of the email
I $G(KEY)'="" M XMY=^XUSEC(KEY)
S:$G(DUZ) XMY(DUZ)="" ;Make sure there's at least one recipient
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECMDECS 3586 printed Nov 22, 2024@17:07:46 Page 2
ECMDECS ;ALB/CMD - Event Capture Management Delete EC Screen ;12/10/21 15:06
+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 ^XUSEC(key) supported by ICR #10076
+8 ; Reference to ^DIK supported by ICR #10013
+9 ; Reference to ^TMP supported by SACC 2.3.2.5.1
+10 ;
DELECSR ;Used by the RPC broker to delete EC Code Sreens in file #720.3
+1 ; Variable passed in:
+2 ; ECIEN - IEN of #720.3
+3 ; ECDUZ - User IEN of #200
+4 ; Variable return
+5 ; ^TMP($J,"ECMSG",n)=Success or failure to remove entries in #720.3^Message
+6 ;
+7 NEW DIK,DA,ECERR
+8 KILL ^TMP($JOB,"ECSCRDEL")
+9 KILL ^TMP($JOB,"ECMSG")
+10 SET ECERR=0
+11 IF ECIEN=""
SET ECERR=1
SET ^TMP($JOB,"ECMSG",1)="0^Event Code Screen is missing"
QUIT
+12 DO CHKDT
IF ECERR
QUIT
+13 DO CHKWRK(ECIEN)
IF ECERR
QUIT
+14 ; Send MailMan message to the holders of ECMGR
DO SENDMM(ECIEN)
+15 SET DIK="^ECJ("
SET DA=ECIEN
DO ^DIK
+16 SET ^TMP($JOB,"ECMSG",1)="1^Event Code Screen Deleted"_U_$GET(ECIEN)
+17 QUIT
+18 ;
CHKDT ;Required Data Check
+1 NEW I,C
+2 SET C=1
+3 FOR I="ECIEN","ECDUZ"
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
+6 ;
CHKWRK(IEN) ;Check if EC Screen had workload
+1 NEW ECSCR,ECL,ECD,ECC,ECP,ECCAT,ECHIEN,ECPROC,ECREC
+2 NEW ARRFND,GREF,STR
+3 SET ECSCR=$$GET1^DIQ(720.3,IEN,".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
End DoDot:2
End DoDot:1
+15 IF $ORDER(ARRFND(STR,""))
SET ^TMP($JOB,"ECMSG",1)="0^Event Code Screen had workload."_U_ECIEN
SET ECERR=1
QUIT
+16 QUIT
SENDMM(IEN) ;
+1 NEW ECMSG,ECTEXT,XMSUB,XMY,XMTEXT,XMDUZ,CNT,SCRSTAT,SYN,LOC,LOCDS,DEFCL,DSSU,CAT,CATD
+2 NEW INACTDT,PN,PRO,PROC,ECREC,ECSCR,ECPI
+3 SET XMSUB="DELETION OF UNUSED EVENT CODE SCREENS FROM File #720.3"
SET XMDUZ="EVENT CAPTURE PACKAGE"
+4 SET XMTEXT="ECTEXT("
+5 DO GETXMY("ECMGR",.XMY)
+6 SET CNT=1
+7 SET ECREC=^ECJ(IEN,0)
SET ECSCR=$PIECE(ECREC,U)
SET INACTDT=$PIECE(ECREC,U,2)
+8 SET DSSU=$PIECE(ECSCR,"-",2)
SET LOC=$PIECE(ECSCR,"-")
SET CAT=$PIECE(ECSCR,"-",3)
+9 SET PRO=$GET(^ECJ(IEN,"PRO"))
SET SYN=$PIECE(PRO,U,2)
SET PROC=$PIECE($PIECE(PRO,U),";")
SET DEFCL=+$PIECE(PRO,U,4)
SET PRO=$PIECE(PRO,U)
+10 IF PRO["EC"
SET PN=$GET(^EC(725,PROC,0))
SET PROC=$PIECE(PN,U)_" ("_$PIECE(PN,U,2)_")"
+11 IF PRO["ICPT"
SET ECPI=$$CPT^ICPTCOD(+PRO)
IF +ECPI>0
Begin DoDot:1
+12 SET PROC=$PIECE(ECPI,U,3)_" ("_$PIECE(ECPI,U,2)_")"
End DoDot:1
+13 SET SCRSTAT=$SELECT(INACTDT'="":"Inactve",1:"Active")
+14 SET CATD=$SELECT('CAT:"None",1:$PIECE($GET(^EC(726,CAT,0)),U))
+15 SET LOCDS=$$GET1^DIQ(4,LOC,.01,"E")
+16 SET ECTEXT(CNT)="The following Event Code Screen has been deleted, it had no workload"
SET CNT=CNT+1
+17 SET ECTEXT(CNT)="associated with it."
SET CNT=CNT+1
+18 SET ECTEXT(CNT)=" "
SET CNT=CNT+1
+19 SET ECTEXT(CNT)="DSS UNIT: "_$$GET1^DIQ(724,DSSU,.01,"E")_" ("_DSSU_")"
SET CNT=CNT+1
+20 SET ECTEXT(CNT)=" LOC: "_LOCDS_$$REPEAT^XLFSTR(" ",(27-$LENGTH(LOCDS)))_"PROC: "_PROC
SET CNT=CNT+1
+21 SET ECTEXT(CNT)=" CAT: "_CATD_$$REPEAT^XLFSTR(" ",(27-$LENGTH(CATD)))_"SYN: "_SYN
SET CNT=CNT+1
+22 SET ECTEXT(CNT)=" DEFAULT ASSOCIATED CLINIC: "_$$GET1^DIQ(44,DEFCL,.01,"E")
SET CNT=CNT+1
+23 SET ECTEXT(CNT)=" STATUS: "_SCRSTAT
SET CNT=CNT+1
+24 SET ECTEXT(CNT)=""
+25 DO ^XMD
+26 QUIT
GETXMY(KEY,XMY) ;Put holders of the KEY into the XMY array to be recipients of the email
+1 IF $GET(KEY)'=""
MERGE XMY=^XUSEC(KEY)
+2 ;Make sure there's at least one recipient
if $GET(DUZ)
SET XMY(DUZ)=""
+3 QUIT
