- 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 Feb 18, 2025@23:23:59 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