ECUTL3 ;ALB/DAN - Event capture utilities (cont) ;2/9/18 14:58
;;2.0;EVENT CAPTURE;**122,131,139**;8 May 96;Build 7
INACTSCR(ACTION) ;Inactivate event code screens associated with inactive national procedure codes
;
;ACTION - optional
; 0 - Don't inactivate, test what would happen
; 1 - Inactivate identified event code screens
;
N SCREEN,LOC,DSSU,ECIEN,DA,DIE,DR,ECSCR,ECPTR,ECDATA,ECFILE
S:'$D(ACTION) ACTION=0 ;If not sent in, assume testing
S ECSCR=0
F S ECSCR=$O(^ECJ("B",ECSCR)) Q:+ECSCR=0 D
.S ECPTR=$P(ECSCR,"-",4),ECIEN=$O(^ECJ("B",ECSCR,0))
.Q:'$D(^ECJ(ECIEN,0)) ;Screen doesn't exist
.Q:+$P(^ECJ(ECIEN,0),"^",2) ;Skip if event code screen is already inactive
.S ECFILE=$P(ECPTR,";",2)
.;ec screens pointing to file #725
.I ECFILE["EC(725" S ECDATA=$G(^EC(725,$P(ECPTR,";",1),0)) D
..Q:$P(ECDATA,U,3)="" ;Skip if national procedure code is active
..I $P(ECDATA,U,3)>DT,ACTION Q ;If inactivation date is in the future and we're inactivating event code screens, skip it as we don't want to inactivate screen until procedure is inactive
..S DSSU=$P(ECSCR,"-",2) Q:DSSU="" ;If no DSS unit, quit
..S SCREEN(DSSU,ECIEN)="" ;put on list to inactivate if not already inactive
I $G(ACTION) S DSSU=0 F S DSSU=$O(SCREEN(DSSU)) Q:'+DSSU S ECIEN=0 F S ECIEN=$O(SCREEN(DSSU,ECIEN)) Q:'+ECIEN D
.S DA=ECIEN,DIE="^ECJ(",DR="1////"_$$DT^XLFDT D ^DIE ;Set inactivation date to today
;
MAIL ;Send email to group showing action taken
N XMSUB,ECTEXT,XMDUZ,XMY,XMZ,XMTEXT,KIEN,DIFROM,LOC,PRO,CNT,PX,CAT,CPT,ACLIN
S XMDUZ="Event Capture Package"
S XMY($G(DUZ,.5))="" ;Set recipient to installer or postmaster
S KIEN=0 F S KIEN=$O(^XUSEC("ECMGR",KIEN)) Q:'+KIEN S XMY(KIEN)="" ;Holders of ECMGR included in email, XUSEC read allowed by DBIA #10076
S XMSUB="Inactivation of Event Code Screens from inactive procedure codes"
S XMTEXT="ECTEXT("
S CNT=1
I '$D(SCREEN) D
.S ECTEXT(CNT)="No Event Code Screens were inactivated, as no inactive",CNT=CNT+1,ECTEXT(CNT)="EC Procedure Codes were found in use.",CNT=CNT+1
I $D(SCREEN) D
.S ECTEXT(CNT)="The following event code screens "_$S($G(ACTION):"",1:"would ")_"have been inactivated",CNT=CNT+1
.S ECTEXT(CNT)="because these Event Code Screens were associated",CNT=CNT+1
.S ECTEXT(CNT)="with inactive EC Procedure Codes.",CNT=CNT+1
I '$G(ACTION),$D(SCREEN) S ECTEXT(CNT)=" ",CNT=CNT+1 D
.S ECTEXT(CNT)="Inactivations have not yet occurred; this list represents event code",CNT=CNT+1,ECTEXT(CNT)="screens that will be inactivated automatically "_$S($G(DAYS):DAYS_" days ",1:"")_"in the future.",CNT=CNT+1
S ECTEXT(CNT)=" ",CNT=CNT+1
S DSSU=0 F S DSSU=$O(SCREEN(DSSU)) Q:'+DSSU D
.S ECTEXT(CNT)="DSS UNIT: "_$$GET1^DIQ(724,DSSU,.01,"E")_" ("_DSSU_")",CNT=CNT+1
.S ECIEN=0 F S ECIEN=$O(SCREEN(DSSU,ECIEN)) Q:'+ECIEN D
..S LOC=$$GET1^DIQ(4,$P($P(^ECJ(ECIEN,0),U),"-"),.01,"E"),PRO=$G(^EC(725,+$P($P(^ECJ(ECIEN,0),U),"-",4),0)),PX=$P(PRO,U,2)_" "_$P(PRO,U)
..S ECTEXT(CNT)=" LOC: "_LOC_$$REPEAT^XLFSTR(" ",(27-$L(LOC)))_"PROC: "_PX,CNT=CNT+1
..S CAT=$P($P(^ECJ(ECIEN,0),U),"-",3),CAT=$S(CAT:$P($G(^EC(726,CAT,0)),U),1:""),CPT=$$GET1^DIQ(81,+$P(PRO,U,5),.01,"E")
..S ECTEXT(CNT)=" CAT: "_CAT_$$REPEAT^XLFSTR(" ",(27-$L(CAT)))_"CPT: "_CPT,CNT=CNT+1
..S ACLIN=$$GET1^DIQ(44,+$P(^ECJ(ECIEN,"PRO"),U,4),.01,"E"),ECTEXT(CNT)=" DEFAULT ASSOCIATED CLINIC: "_ACLIN,CNT=CNT+1
..S ECTEXT(CNT)=" ",CNT=CNT+1
D ^XMD ;Send email
Q
;
QINACT ;Queue the inactivation of event code screens to happen
;in the background. Comes from "AC" cross reference of the
;INACTIVE DATE (#2) field of file 725
N ZTRTN,ZTDTH,ZTDESC,ZTIO,ZTSK
S ZTRTN="INACTSCR^ECUTL3(1)",ZTDTH=$H,ZTDESC="Inactivate event code screens with inactive procedure codes",ZTIO="" D ^%ZTLOAD
Q
;
CHKDSS ;131,139 Inactivate any DSS units that are set to send no records or OOS and have an inactive/invalid stop code
N UNIT,DSS0,SC0,BAD,UPDATE
S UNIT=0 F S UNIT=$O(^ECD(UNIT)) Q:'+UNIT D
.S BAD=0
.S DSS0=$G(^ECD(UNIT,0))
.I $P(DSS0,U,6) Q ;DSS Unit is inactive
.I $P(DSS0,U,14)="A" Q ;139 only look at "send no records" and "OOS" units
.S SC0=$G(^DIC(40.7,+$P(DSS0,U,10),0)) ;Get stop code zero node
.I $P(SC0,U,3) I $P(SC0,U,3)'>DT S BAD=1 ;Stop code is inactive
.I $P(SC0,U,6)="S"!($P(SC0,U,6)="") S BAD=1 ;Stop code is a secondary code or is not set
.I $L($P(SC0,U,2))'=3 S BAD=1 ;Stop code is not 3 digits in length
.I BAD S UPDATE($P(DSS0,U)_U_UNIT)="" S $P(^ECD(UNIT,0),U,6)=1 ;Store changed DSS unit for report and inactivate DSS unit
;Send results via email
N XMSUB,ECTEXT,XMDUZ,XMY,XMZ,XMTEXT,KIEN,DIFROM,NAME,CNT
S XMDUZ="Event Capture Package"
S XMY($G(DUZ,.5))="" ;Set recipient to installer or postmaster
S KIEN=0 F S KIEN=$O(^XUSEC("ECMGR",KIEN)) Q:'+KIEN S XMY(KIEN)="" ;Holders of ECMGR included in email, XUSEC read allowed by DBIA #10076
S ECTEXT(1)="The check for DSS Units with a Send to PCE setting of 'Send no records'"
S ECTEXT(2)="or 'OOS' and an invalid/inactive stop code has completed." ;139
S ECTEXT(3)="" ;139
S ECTEXT(4)="Below are the results." ;139
S ECTEXT(5)="" ;139
I '$D(UPDATE) S ECTEXT(6)="No DSS Units were identified. No further action is required." ;139
S CNT=6 ;139 start with line 6 to add to message
I $D(UPDATE) D
.S ECTEXT(CNT)="The following DSS Units were inactivated:",CNT=CNT+1,ECTEXT(CNT)="",CNT=CNT+1
.S ECTEXT(CNT)="NAME"_$$REPEAT^XLFSTR(" ",28)_"DSS IEN",CNT=CNT+1,ECTEXT(CNT)="----"_$$REPEAT^XLFSTR(" ",28)_"-------",CNT=CNT+1
.S NAME="" F S NAME=$O(UPDATE(NAME)) Q:NAME="" S ECTEXT(CNT)=$P(NAME,U)_$$REPEAT^XLFSTR(" ",(32-$L($P(NAME,U))))_$P(NAME,U,2),CNT=CNT+1
S XMTEXT="ECTEXT(",XMSUB="DSS Unit stop code review"
D ^XMD ;Send email
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECUTL3 5787 printed Dec 13, 2024@01:59:15 Page 2
ECUTL3 ;ALB/DAN - Event capture utilities (cont) ;2/9/18 14:58
+1 ;;2.0;EVENT CAPTURE;**122,131,139**;8 May 96;Build 7
INACTSCR(ACTION) ;Inactivate event code screens associated with inactive national procedure codes
+1 ;
+2 ;ACTION - optional
+3 ; 0 - Don't inactivate, test what would happen
+4 ; 1 - Inactivate identified event code screens
+5 ;
+6 NEW SCREEN,LOC,DSSU,ECIEN,DA,DIE,DR,ECSCR,ECPTR,ECDATA,ECFILE
+7 ;If not sent in, assume testing
if '$DATA(ACTION)
SET ACTION=0
+8 SET ECSCR=0
+9 FOR
SET ECSCR=$ORDER(^ECJ("B",ECSCR))
if +ECSCR=0
QUIT
Begin DoDot:1
+10 SET ECPTR=$PIECE(ECSCR,"-",4)
SET ECIEN=$ORDER(^ECJ("B",ECSCR,0))
+11 ;Screen doesn't exist
if '$DATA(^ECJ(ECIEN,0))
QUIT
+12 ;Skip if event code screen is already inactive
if +$PIECE(^ECJ(ECIEN,0),"^",2)
QUIT
+13 SET ECFILE=$PIECE(ECPTR,";",2)
+14 ;ec screens pointing to file #725
+15 IF ECFILE["EC(725"
SET ECDATA=$GET(^EC(725,$PIECE(ECPTR,";",1),0))
Begin DoDot:2
+16 ;Skip if national procedure code is active
if $PIECE(ECDATA,U,3)=""
QUIT
+17 ;If inactivation date is in the future and we're inactivating event code screens, skip it as we don't want to inactivate screen until procedure is inactive
IF $PIECE(ECDATA,U,3)>DT
IF ACTION
QUIT
+18 ;If no DSS unit, quit
SET DSSU=$PIECE(ECSCR,"-",2)
if DSSU=""
QUIT
+19 ;put on list to inactivate if not already inactive
SET SCREEN(DSSU,ECIEN)=""
End DoDot:2
End DoDot:1
+20 IF $GET(ACTION)
SET DSSU=0
FOR
SET DSSU=$ORDER(SCREEN(DSSU))
if '+DSSU
QUIT
SET ECIEN=0
FOR
SET ECIEN=$ORDER(SCREEN(DSSU,ECIEN))
if '+ECIEN
QUIT
Begin DoDot:1
+21 ;Set inactivation date to today
SET DA=ECIEN
SET DIE="^ECJ("
SET DR="1////"_$$DT^XLFDT
DO ^DIE
End DoDot:1
+22 ;
MAIL ;Send email to group showing action taken
+1 NEW XMSUB,ECTEXT,XMDUZ,XMY,XMZ,XMTEXT,KIEN,DIFROM,LOC,PRO,CNT,PX,CAT,CPT,ACLIN
+2 SET XMDUZ="Event Capture Package"
+3 ;Set recipient to installer or postmaster
SET XMY($GET(DUZ,.5))=""
+4 ;Holders of ECMGR included in email, XUSEC read allowed by DBIA #10076
SET KIEN=0
FOR
SET KIEN=$ORDER(^XUSEC("ECMGR",KIEN))
if '+KIEN
QUIT
SET XMY(KIEN)=""
+5 SET XMSUB="Inactivation of Event Code Screens from inactive procedure codes"
+6 SET XMTEXT="ECTEXT("
+7 SET CNT=1
+8 IF '$DATA(SCREEN)
Begin DoDot:1
+9 SET ECTEXT(CNT)="No Event Code Screens were inactivated, as no inactive"
SET CNT=CNT+1
SET ECTEXT(CNT)="EC Procedure Codes were found in use."
SET CNT=CNT+1
End DoDot:1
+10 IF $DATA(SCREEN)
Begin DoDot:1
+11 SET ECTEXT(CNT)="The following event code screens "_$SELECT($GET(ACTION):"",1:"would ")_"have been inactivated"
SET CNT=CNT+1
+12 SET ECTEXT(CNT)="because these Event Code Screens were associated"
SET CNT=CNT+1
+13 SET ECTEXT(CNT)="with inactive EC Procedure Codes."
SET CNT=CNT+1
End DoDot:1
+14 IF '$GET(ACTION)
IF $DATA(SCREEN)
SET ECTEXT(CNT)=" "
SET CNT=CNT+1
Begin DoDot:1
+15 SET ECTEXT(CNT)="Inactivations have not yet occurred; this list represents event code"
SET CNT=CNT+1
SET ECTEXT(CNT)="screens that will be inactivated automatically "_$SELECT($GET(DAYS):DAYS_" days ",1:"")_"in the future."
SET CNT=CNT+1
End DoDot:1
+16 SET ECTEXT(CNT)=" "
SET CNT=CNT+1
+17 SET DSSU=0
FOR
SET DSSU=$ORDER(SCREEN(DSSU))
if '+DSSU
QUIT
Begin DoDot:1
+18 SET ECTEXT(CNT)="DSS UNIT: "_$$GET1^DIQ(724,DSSU,.01,"E")_" ("_DSSU_")"
SET CNT=CNT+1
+19 SET ECIEN=0
FOR
SET ECIEN=$ORDER(SCREEN(DSSU,ECIEN))
if '+ECIEN
QUIT
Begin DoDot:2
+20 SET LOC=$$GET1^DIQ(4,$PIECE($PIECE(^ECJ(ECIEN,0),U),"-"),.01,"E")
SET PRO=$GET(^EC(725,+$PIECE($PIECE(^ECJ(ECIEN,0),U),"-",4),0))
SET PX=$PIECE(PRO,U,2)_" "_$PIECE(PRO,U)
+21 SET ECTEXT(CNT)=" LOC: "_LOC_$$REPEAT^XLFSTR(" ",(27-$LENGTH(LOC)))_"PROC: "_PX
SET CNT=CNT+1
+22 SET CAT=$PIECE($PIECE(^ECJ(ECIEN,0),U),"-",3)
SET CAT=$SELECT(CAT:$PIECE($GET(^EC(726,CAT,0)),U),1:"")
SET CPT=$$GET1^DIQ(81,+$PIECE(PRO,U,5),.01,"E")
+23 SET ECTEXT(CNT)=" CAT: "_CAT_$$REPEAT^XLFSTR(" ",(27-$LENGTH(CAT)))_"CPT: "_CPT
SET CNT=CNT+1
+24 SET ACLIN=$$GET1^DIQ(44,+$PIECE(^ECJ(ECIEN,"PRO"),U,4),.01,"E")
SET ECTEXT(CNT)=" DEFAULT ASSOCIATED CLINIC: "_ACLIN
SET CNT=CNT+1
+25 SET ECTEXT(CNT)=" "
SET CNT=CNT+1
End DoDot:2
End DoDot:1
+26 ;Send email
DO ^XMD
+27 QUIT
+28 ;
QINACT ;Queue the inactivation of event code screens to happen
+1 ;in the background. Comes from "AC" cross reference of the
+2 ;INACTIVE DATE (#2) field of file 725
+3 NEW ZTRTN,ZTDTH,ZTDESC,ZTIO,ZTSK
+4 SET ZTRTN="INACTSCR^ECUTL3(1)"
SET ZTDTH=$HOROLOG
SET ZTDESC="Inactivate event code screens with inactive procedure codes"
SET ZTIO=""
DO ^%ZTLOAD
+5 QUIT
+6 ;
CHKDSS ;131,139 Inactivate any DSS units that are set to send no records or OOS and have an inactive/invalid stop code
+1 NEW UNIT,DSS0,SC0,BAD,UPDATE
+2 SET UNIT=0
FOR
SET UNIT=$ORDER(^ECD(UNIT))
if '+UNIT
QUIT
Begin DoDot:1
+3 SET BAD=0
+4 SET DSS0=$GET(^ECD(UNIT,0))
+5 ;DSS Unit is inactive
IF $PIECE(DSS0,U,6)
QUIT
+6 ;139 only look at "send no records" and "OOS" units
IF $PIECE(DSS0,U,14)="A"
QUIT
+7 ;Get stop code zero node
SET SC0=$GET(^DIC(40.7,+$PIECE(DSS0,U,10),0))
+8 ;Stop code is inactive
IF $PIECE(SC0,U,3)
IF $PIECE(SC0,U,3)'>DT
SET BAD=1
+9 ;Stop code is a secondary code or is not set
IF $PIECE(SC0,U,6)="S"!($PIECE(SC0,U,6)="")
SET BAD=1
+10 ;Stop code is not 3 digits in length
IF $LENGTH($PIECE(SC0,U,2))'=3
SET BAD=1
+11 ;Store changed DSS unit for report and inactivate DSS unit
IF BAD
SET UPDATE($PIECE(DSS0,U)_U_UNIT)=""
SET $PIECE(^ECD(UNIT,0),U,6)=1
End DoDot:1
+12 ;Send results via email
+13 NEW XMSUB,ECTEXT,XMDUZ,XMY,XMZ,XMTEXT,KIEN,DIFROM,NAME,CNT
+14 SET XMDUZ="Event Capture Package"
+15 ;Set recipient to installer or postmaster
SET XMY($GET(DUZ,.5))=""
+16 ;Holders of ECMGR included in email, XUSEC read allowed by DBIA #10076
SET KIEN=0
FOR
SET KIEN=$ORDER(^XUSEC("ECMGR",KIEN))
if '+KIEN
QUIT
SET XMY(KIEN)=""
+17 SET ECTEXT(1)="The check for DSS Units with a Send to PCE setting of 'Send no records'"
+18 ;139
SET ECTEXT(2)="or 'OOS' and an invalid/inactive stop code has completed."
+19 ;139
SET ECTEXT(3)=""
+20 ;139
SET ECTEXT(4)="Below are the results."
+21 ;139
SET ECTEXT(5)=""
+22 ;139
IF '$DATA(UPDATE)
SET ECTEXT(6)="No DSS Units were identified. No further action is required."
+23 ;139 start with line 6 to add to message
SET CNT=6
+24 IF $DATA(UPDATE)
Begin DoDot:1
+25 SET ECTEXT(CNT)="The following DSS Units were inactivated:"
SET CNT=CNT+1
SET ECTEXT(CNT)=""
SET CNT=CNT+1
+26 SET ECTEXT(CNT)="NAME"_$$REPEAT^XLFSTR(" ",28)_"DSS IEN"
SET CNT=CNT+1
SET ECTEXT(CNT)="----"_$$REPEAT^XLFSTR(" ",28)_"-------"
SET CNT=CNT+1
+27 SET NAME=""
FOR
SET NAME=$ORDER(UPDATE(NAME))
if NAME=""
QUIT
SET ECTEXT(CNT)=$PIECE(NAME,U)_$$REPEAT^XLFSTR(" ",(32-$LENGTH($PIECE(NAME,U))))_$PIECE(NAME,U,2)
SET CNT=CNT+1
End DoDot:1
+28 SET XMTEXT="ECTEXT("
SET XMSUB="DSS Unit stop code review"
+29 ;Send email
DO ^XMD
+30 QUIT
