Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECMDECS

ECMDECS.m

Go to the documentation of this file.
  1. 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
  1. ;
  1. ; Reference to $$CPT^ICPTCOD supported by ICR #1995
  1. ; Reference to $$GET1^DIQ supported by ICR #2056
  1. ; Reference to $$REPEAT^XLFSTR supported by ICR #10104
  1. ; Reference to ^XMD supported by ICR #10070
  1. ; Reference to ^XUSEC(key) supported by ICR #10076
  1. ; Reference to ^DIK supported by ICR #10013
  1. ; Reference to ^TMP supported by SACC 2.3.2.5.1
  1. ;
  1. DELECSR ;Used by the RPC broker to delete EC Code Sreens in file #720.3
  1. ; Variable passed in:
  1. ; ECIEN - IEN of #720.3
  1. ; ECDUZ - User IEN of #200
  1. ; Variable return
  1. ; ^TMP($J,"ECMSG",n)=Success or failure to remove entries in #720.3^Message
  1. ;
  1. N DIK,DA,ECERR
  1. K ^TMP($J,"ECSCRDEL")
  1. K ^TMP($J,"ECMSG")
  1. S ECERR=0
  1. I ECIEN="" S ECERR=1,^TMP($J,"ECMSG",1)="0^Event Code Screen is missing" Q
  1. D CHKDT I ECERR Q
  1. D CHKWRK(ECIEN) I ECERR Q
  1. D SENDMM(ECIEN) ; Send MailMan message to the holders of ECMGR
  1. S DIK="^ECJ(",DA=ECIEN D ^DIK
  1. S ^TMP($J,"ECMSG",1)="1^Event Code Screen Deleted"_U_$G(ECIEN)
  1. Q
  1. ;
  1. CHKDT ;Required Data Check
  1. N I,C
  1. S C=1
  1. F I="ECIEN","ECDUZ" D
  1. .I $G(@I)="" S ^TMP($J,"ECMSG",C)="0^Key data missing "_I,C=C+1,ECERR=1
  1. Q
  1. ;
  1. CHKWRK(IEN) ;Check if EC Screen had workload
  1. N ECSCR,ECL,ECD,ECC,ECP,ECCAT,ECHIEN,ECPROC,ECREC
  1. N ARRFND,GREF,STR
  1. S ECSCR=$$GET1^DIQ(720.3,IEN,".01","I")
  1. S ECL=$P(ECSCR,"-"),ECD=$P(ECSCR,"-",2),ECC=$P(ECSCR,"-",3),ECP=$P(ECSCR,"-",4)
  1. I ECC="" S ECC=0
  1. S GREF="^ECH(""ADT"",ECL)"
  1. S STR=ECL_"-"_ECD_"-"_ECC_"-"_ECP
  1. F S GREF=$Q(@GREF) Q:$QS(GREF,1)'["ADT" Q:$QS(GREF,2)'=ECL D
  1. . I $QS(GREF,4)'=ECD Q
  1. . S ECHIEN=$QS(GREF,6)
  1. . S ECREC=^ECH(ECHIEN,0)
  1. . S ECCAT=$P(ECREC,U,8),ECPROC=$P(ECREC,U,9)
  1. . I (ECCAT=ECC),(ECPROC=ECP) D
  1. .. S ARRFND(STR,ECHIEN)=ECIEN
  1. I $O(ARRFND(STR,"")) S ^TMP($J,"ECMSG",1)="0^Event Code Screen had workload."_U_ECIEN,ECERR=1 Q
  1. Q
  1. SENDMM(IEN) ;
  1. N ECMSG,ECTEXT,XMSUB,XMY,XMTEXT,XMDUZ,CNT,SCRSTAT,SYN,LOC,LOCDS,DEFCL,DSSU,CAT,CATD
  1. N INACTDT,PN,PRO,PROC,ECREC,ECSCR,ECPI
  1. S XMSUB="DELETION OF UNUSED EVENT CODE SCREENS FROM File #720.3",XMDUZ="EVENT CAPTURE PACKAGE"
  1. S XMTEXT="ECTEXT("
  1. D GETXMY("ECMGR",.XMY)
  1. S CNT=1
  1. S ECREC=^ECJ(IEN,0),ECSCR=$P(ECREC,U),INACTDT=$P(ECREC,U,2)
  1. S DSSU=$P(ECSCR,"-",2),LOC=$P(ECSCR,"-"),CAT=$P(ECSCR,"-",3)
  1. 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)
  1. I PRO["EC" S PN=$G(^EC(725,PROC,0)),PROC=$P(PN,U)_" ("_$P(PN,U,2)_")"
  1. I PRO["ICPT" S ECPI=$$CPT^ICPTCOD(+PRO) I +ECPI>0 D
  1. . S PROC=$P(ECPI,U,3)_" ("_$P(ECPI,U,2)_")"
  1. S SCRSTAT=$S(INACTDT'="":"Inactve",1:"Active")
  1. S CATD=$S('CAT:"None",1:$P($G(^EC(726,CAT,0)),U))
  1. S LOCDS=$$GET1^DIQ(4,LOC,.01,"E")
  1. S ECTEXT(CNT)="The following Event Code Screen has been deleted, it had no workload",CNT=CNT+1
  1. S ECTEXT(CNT)="associated with it.",CNT=CNT+1
  1. S ECTEXT(CNT)=" ",CNT=CNT+1
  1. S ECTEXT(CNT)="DSS UNIT: "_$$GET1^DIQ(724,DSSU,.01,"E")_" ("_DSSU_")",CNT=CNT+1
  1. S ECTEXT(CNT)=" LOC: "_LOCDS_$$REPEAT^XLFSTR(" ",(27-$L(LOCDS)))_"PROC: "_PROC,CNT=CNT+1
  1. S ECTEXT(CNT)=" CAT: "_CATD_$$REPEAT^XLFSTR(" ",(27-$L(CATD)))_"SYN: "_SYN,CNT=CNT+1
  1. S ECTEXT(CNT)=" DEFAULT ASSOCIATED CLINIC: "_$$GET1^DIQ(44,DEFCL,.01,"E"),CNT=CNT+1
  1. S ECTEXT(CNT)=" STATUS: "_SCRSTAT,CNT=CNT+1
  1. S ECTEXT(CNT)=""
  1. D ^XMD
  1. Q
  1. GETXMY(KEY,XMY) ;Put holders of the KEY into the XMY array to be recipients of the email
  1. I $G(KEY)'="" M XMY=^XUSEC(KEY)
  1. S:$G(DUZ) XMY(DUZ)="" ;Make sure there's at least one recipient
  1. Q