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