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

ECUTL3.m

Go to the documentation of this file.
  1. 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
  1. INACTSCR(ACTION) ;Inactivate event code screens associated with inactive national procedure codes
  1. ;
  1. ;ACTION - optional
  1. ; 0 - Don't inactivate, test what would happen
  1. ; 1 - Inactivate identified event code screens
  1. ;
  1. N SCREEN,LOC,DSSU,ECIEN,DA,DIE,DR,ECSCR,ECPTR,ECDATA,ECFILE
  1. S:'$D(ACTION) ACTION=0 ;If not sent in, assume testing
  1. S ECSCR=0
  1. F S ECSCR=$O(^ECJ("B",ECSCR)) Q:+ECSCR=0 D
  1. .S ECPTR=$P(ECSCR,"-",4),ECIEN=$O(^ECJ("B",ECSCR,0))
  1. .Q:'$D(^ECJ(ECIEN,0)) ;Screen doesn't exist
  1. .Q:+$P(^ECJ(ECIEN,0),"^",2) ;Skip if event code screen is already inactive
  1. .S ECFILE=$P(ECPTR,";",2)
  1. .;ec screens pointing to file #725
  1. .I ECFILE["EC(725" S ECDATA=$G(^EC(725,$P(ECPTR,";",1),0)) D
  1. ..Q:$P(ECDATA,U,3)="" ;Skip if national procedure code is active
  1. ..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
  1. ..S DSSU=$P(ECSCR,"-",2) Q:DSSU="" ;If no DSS unit, quit
  1. ..S SCREEN(DSSU,ECIEN)="" ;put on list to inactivate if not already inactive
  1. 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
  1. .S DA=ECIEN,DIE="^ECJ(",DR="1////"_$$DT^XLFDT D ^DIE ;Set inactivation date to today
  1. ;
  1. MAIL ;Send email to group showing action taken
  1. N XMSUB,ECTEXT,XMDUZ,XMY,XMZ,XMTEXT,KIEN,DIFROM,LOC,PRO,CNT,PX,CAT,CPT,ACLIN
  1. S XMDUZ="Event Capture Package"
  1. S XMY($G(DUZ,.5))="" ;Set recipient to installer or postmaster
  1. 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
  1. S XMSUB="Inactivation of Event Code Screens from inactive procedure codes"
  1. S XMTEXT="ECTEXT("
  1. S CNT=1
  1. I '$D(SCREEN) D
  1. .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
  1. I $D(SCREEN) D
  1. .S ECTEXT(CNT)="The following event code screens "_$S($G(ACTION):"",1:"would ")_"have been inactivated",CNT=CNT+1
  1. .S ECTEXT(CNT)="because these Event Code Screens were associated",CNT=CNT+1
  1. .S ECTEXT(CNT)="with inactive EC Procedure Codes.",CNT=CNT+1
  1. I '$G(ACTION),$D(SCREEN) S ECTEXT(CNT)=" ",CNT=CNT+1 D
  1. .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
  1. S ECTEXT(CNT)=" ",CNT=CNT+1
  1. S DSSU=0 F S DSSU=$O(SCREEN(DSSU)) Q:'+DSSU D
  1. .S ECTEXT(CNT)="DSS UNIT: "_$$GET1^DIQ(724,DSSU,.01,"E")_" ("_DSSU_")",CNT=CNT+1
  1. .S ECIEN=0 F S ECIEN=$O(SCREEN(DSSU,ECIEN)) Q:'+ECIEN D
  1. ..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)
  1. ..S ECTEXT(CNT)=" LOC: "_LOC_$$REPEAT^XLFSTR(" ",(27-$L(LOC)))_"PROC: "_PX,CNT=CNT+1
  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")
  1. ..S ECTEXT(CNT)=" CAT: "_CAT_$$REPEAT^XLFSTR(" ",(27-$L(CAT)))_"CPT: "_CPT,CNT=CNT+1
  1. ..S ACLIN=$$GET1^DIQ(44,+$P(^ECJ(ECIEN,"PRO"),U,4),.01,"E"),ECTEXT(CNT)=" DEFAULT ASSOCIATED CLINIC: "_ACLIN,CNT=CNT+1
  1. ..S ECTEXT(CNT)=" ",CNT=CNT+1
  1. D ^XMD ;Send email
  1. Q
  1. ;
  1. QINACT ;Queue the inactivation of event code screens to happen
  1. ;in the background. Comes from "AC" cross reference of the
  1. ;INACTIVE DATE (#2) field of file 725
  1. N ZTRTN,ZTDTH,ZTDESC,ZTIO,ZTSK
  1. S ZTRTN="INACTSCR^ECUTL3(1)",ZTDTH=$H,ZTDESC="Inactivate event code screens with inactive procedure codes",ZTIO="" D ^%ZTLOAD
  1. Q
  1. ;
  1. CHKDSS ;131,139 Inactivate any DSS units that are set to send no records or OOS and have an inactive/invalid stop code
  1. N UNIT,DSS0,SC0,BAD,UPDATE
  1. S UNIT=0 F S UNIT=$O(^ECD(UNIT)) Q:'+UNIT D
  1. .S BAD=0
  1. .S DSS0=$G(^ECD(UNIT,0))
  1. .I $P(DSS0,U,6) Q ;DSS Unit is inactive
  1. .I $P(DSS0,U,14)="A" Q ;139 only look at "send no records" and "OOS" units
  1. .S SC0=$G(^DIC(40.7,+$P(DSS0,U,10),0)) ;Get stop code zero node
  1. .I $P(SC0,U,3) I $P(SC0,U,3)'>DT S BAD=1 ;Stop code is inactive
  1. .I $P(SC0,U,6)="S"!($P(SC0,U,6)="") S BAD=1 ;Stop code is a secondary code or is not set
  1. .I $L($P(SC0,U,2))'=3 S BAD=1 ;Stop code is not 3 digits in length
  1. .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
  1. ;Send results via email
  1. N XMSUB,ECTEXT,XMDUZ,XMY,XMZ,XMTEXT,KIEN,DIFROM,NAME,CNT
  1. S XMDUZ="Event Capture Package"
  1. S XMY($G(DUZ,.5))="" ;Set recipient to installer or postmaster
  1. 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
  1. S ECTEXT(1)="The check for DSS Units with a Send to PCE setting of 'Send no records'"
  1. S ECTEXT(2)="or 'OOS' and an invalid/inactive stop code has completed." ;139
  1. S ECTEXT(3)="" ;139
  1. S ECTEXT(4)="Below are the results." ;139
  1. S ECTEXT(5)="" ;139
  1. I '$D(UPDATE) S ECTEXT(6)="No DSS Units were identified. No further action is required." ;139
  1. S CNT=6 ;139 start with line 6 to add to message
  1. I $D(UPDATE) D
  1. .S ECTEXT(CNT)="The following DSS Units were inactivated:",CNT=CNT+1,ECTEXT(CNT)="",CNT=CNT+1
  1. .S ECTEXT(CNT)="NAME"_$$REPEAT^XLFSTR(" ",28)_"DSS IEN",CNT=CNT+1,ECTEXT(CNT)="----"_$$REPEAT^XLFSTR(" ",28)_"-------",CNT=CNT+1
  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
  1. S XMTEXT="ECTEXT(",XMSUB="DSS Unit stop code review"
  1. D ^XMD ;Send email
  1. Q