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

ECMDDSSU.m

Go to the documentation of this file.
  1. 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
  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 ^DIK supported by ICR #10013
  1. ; Reference to ^VA(200 supported by ICR #10060
  1. ; Reference to ^TMP supported by SACC 2.3.2.5.1
  1. ;
  1. DELDSS ;Used by the RPC broker to delete unused DSS Unit in file #724
  1. ; Variable passed in:
  1. ; ECIEN - IEN of #724
  1. ; ECDUZ - User IEN of #200
  1. ; Variable return
  1. ; ^TMP($J,"ECMSG",n)=Success or failure to remove entries in #724^Message
  1. ;
  1. N ARRFND,DIK,DA,DIE,ECARR,ECDECS,GREF,FOUND,ECERR,ECFILE,ECUSR,DSSUSR,ECSIEN,DSSIEN,CNT
  1. S ECERR=0
  1. D CHKDT^ECMDECS I ECERR Q
  1. S DSSIEN=ECIEN
  1. S GREF="^ECH(""ADT"")",FOUND=0
  1. F S GREF=$Q(@GREF) Q:$QS(GREF,1)'="ADT" D Q:FOUND
  1. . I $QS(GREF,4)=DSSIEN S FOUND=1,ARRFND($QS(GREF,2),$QS(GREF,3),$QS(GREF,4))=""
  1. I FOUND S ECERR=1,^TMP($J,"ECMSG",1)="0^DSS Unit had workload"_U_$G(ECIEN) Q
  1. I 'FOUND D ECHKSCR(DSSIEN,.ECDECS) Q:ECERR
  1. I '$D(ECDECS) S ECERR=1,^TMP($J,"ECMSG",1)="0^DSS Unit had workload on its Event Code Screens" Q
  1. D ECUSR^ECUMRPC(.DSSURES,DSSIEN)
  1. M DSSUSR=@DSSURES
  1. S CNT=0
  1. F CNT=$O(DSSUSR(CNT)) Q:'CNT S ECUSR($P(DSSUSR(CNT),U,2))=""
  1. D DSSUSRDE(DSSIEN,.ECUSR) ;Deallocate users to DSS Unit
  1. I $D(ECDECS) D SENDMM(.ECDECS) ;Send MM to list DSS unit and its EC Screen to be deleted
  1. S ECSIEN=""
  1. F S ECSIEN=$O(ECDECS(DSSIEN,ECSIEN)) Q:ECSIEN="" D
  1. . S DIK="^ECJ(",DA=ECSIEN D ^DIK
  1. S DIK="^ECD(",DA=DSSIEN D ^DIK
  1. S ^TMP($J,"ECMSG",1)="1^DSS Unit Deleted"_U_$G(ECIEN)
  1. D KILLVAR^ECFLRPC
  1. K ^TMP($J,"ECUSR")
  1. S RESULTS=$NA(^TMP($J,"ECMSG"))
  1. Q
  1. ;
  1. ECHKSCR(DSSUNT,DELECS) ;
  1. ;Get all EC Screen for the DSS Unit
  1. ;Check them again before delete EC screeens and DSS Unit
  1. N GLBREF,ECLOC,ECCAT,ECPROC,ECSCR,ECSOK
  1. S GLBREF="^ECJ(""AP"")"
  1. S ECSOK=1
  1. F S GLBREF=$Q(@GLBREF) Q:$QS(GLBREF,1)'="AP" D
  1. .I $QS(GLBREF,3)'=DSSUNT Q
  1. .S ECCAT=$QS(GLBREF,4),ECPROC=$QS(GLBREF,5),ECLOC=$QS(GLBREF,2),ECSCR=$QS(GLBREF,6)
  1. .S ECSOK=1 D CHKWRK(ECSCR,.ECSOK)
  1. .I ECSOK S DELECS(DSSUNT,ECSCR)=""
  1. I ECSOK,'$D(DELECS) S DELECS(DSSUNT,0)=""
  1. Q
  1. ;
  1. CHKWRK(ECIEN,DELOK) ;
  1. N ECREC,ECSCR,ECL,ECD,ECC,ECCAT,ECP,ECHIEN,ECPROC
  1. N ARRFND,GREF,STR
  1. S ECSCR=$$GET1^DIQ(720.3,ECIEN,".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 Q:'DELOK
  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 Q:'DELOK
  1. .. S ARRFND(STR,ECHIEN)=ECIEN
  1. .. S DELOK=0
  1. Q
  1. DSSUSRDE(DSSUNT,USRARR) ;Deallocate Users to DSS Unit
  1. N EDUZ,DIK,X,Y,DA
  1. S EDUZ=0
  1. F S EDUZ=$O(^VA(200,EDUZ)) Q:'EDUZ I $D(^VA(200,EDUZ,"EC",DSSUNT,0)) D
  1. . I '$D(USRARR(EDUZ)) Q
  1. . K DA,DIK S DA(1)=EDUZ,DA=DSSUNT,DIK="^VA(200,"_DA(1)_",""EC"","
  1. . D ^DIK K USRARR(EDUZ)
  1. Q
  1. ;
  1. SENDMM(ECSARR) ;Send Mailman message
  1. N ECMSG,ECTEXT,XMSUB,XMY,XMTEXT,XMDUZ,CNT,SCRSTAT,SYN,LOC,LOCDS,DEFCL,DSSREC,DSS,DSSU,DSSNM
  1. N INACTDT,PN,PRO,PROC,ECREC,ECSCR,ECPI,SCR,CAT,CATD,IEN
  1. S XMSUB="DELETION OF UNUSED DSS UNIT FROM FILE #724",XMDUZ="EVENT CAPTURE PACKAGE"
  1. S XMTEXT="ECTEXT("
  1. D GETXMY^ECMDECS("ECMGR",.XMY)
  1. S CNT=1,SCR=""
  1. S DSS=$O(ECSARR(""))
  1. S DSSREC=^ECD(DSS,0)
  1. S DSSNM=$P(DSSREC,U)
  1. I $O(ECSARR(DSS,0))="" d Q
  1. .S ECTEXT(CNT)="The following DSS Unit has been deleted, it had no workload associated with it.",CNT=CNT+1
  1. .S ECTEXT(CNT)="This DSS Unit had no Event Code Screens associated with it.",CNT=CNT+1
  1. .S ECTEXT(CNT)=" ",CNT=CNT+1
  1. .S ECTEXT(CNT)="DSS UNIT: "_$$GET1^DIQ(724,DSS,.01,"E")_" ("_DSS_")",CNT=CNT+1
  1. .S ECTEXT(CNT)=" ",CNT=CNT+1
  1. .D ^XMD
  1. S ECTEXT(CNT)="The following DSS Unit and its associated Event Code Screens have been deleted,",CNT=CNT+1
  1. S ECTEXT(CNT)="it had no workload associated with it.",CNT=CNT+1
  1. S ECTEXT(CNT)=" ",CNT=CNT+1
  1. S ECTEXT(CNT)="DSS UNIT: "_$$GET1^DIQ(724,DSS,.01,"E")_" ("_DSS_")",CNT=CNT+1
  1. S ECTEXT(CNT)=" ",CNT=CNT+1
  1. F S SCR=$O(ECSARR(DSS,SCR)) Q:SCR="" D
  1. .S ECREC=^ECJ(SCR,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(SCR,"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,2)_" "_$P(PN,U)
  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)=" 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)=" ",CNT=CNT+1
  1. D ^XMD
  1. Q