EC2P122 ;ALB/DAN Post-install events for Event Capture patch 122 ;2/5/14 16:42
;;2.0;EVENT CAPTURE;**122**;8 May 96;Build 2
;
POST ;Come here for post-install actions
D ADDNEW ;Add new procedure reasons to the procedure reasons file
D INACT ;Inactivate event code screens with inactive procedure codes
Q
;
ADDNEW ;Add new entry to file 720.4
;
N ECXFDA,ECXERR,ECREAS,I
;
;-get procedure reason
F I=1:1 S ECREAS=$P($T(ADDREAS+I),";;",2) Q:ECREAS="QUIT" D
.;
.;-quit w/error message if entry already exists in file #720.4
.I $$FIND1^DIC(720.4,"","X",ECREAS) D Q
..D BMES^XPDUTL(">>>..."_ECREAS_" not added, entry already exists.")
.;
.;Setup field values of new entry
.S ECXFDA(720.4,"+1,",.01)=ECREAS
.S ECXFDA(720.4,"+1,",.02)=1 ;Set "ACTIVE?" field to 1 (active)
.;
.;-add new entry to file #720.4
.D UPDATE^DIE("E","ECXFDA","","ECXERR")
.;
.I '$D(ECXERR) D BMES^XPDUTL(">>>...."_ECREAS_" added to file.")
.I $D(ECXERR) D BMES^XPDUTL(">>>....Unable to add "_ECREAS_" to file.")
;
Q
;
INACT ;Find inactive event code screens with inactive procedure codes
N DAYS,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
S DAYS=$S($$PROD^XUPROD:30,1:3) ;Event code screen clean up happens in 3 days if installed in test, 30 days if in production
D BMES^XPDUTL("Identifying event code screens with inactive EC Procedure Codes.") D MES^XPDUTL("A list of findings will be emailed to holders of the ECMGR key.")
D INACTSCR^ECUTL3(0) ;Start scanning event code screens in "report only" mode
D BMES^XPDUTL("Any event code screens with inactive EC Procedure Codes will be") D MES^XPDUTL("automatically inactivated "_DAYS_" days from now. Creating background task") D MES^XPDUTL("for this process.")
S ZTRTN="INACTSCR^ECUTL3(1)",ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,DAYS),ZTIO="",ZTDESC="Inactivation of event code screens with inactive EC Procedure Codes" D ^%ZTLOAD
I $G(ZTSK) D BMES^XPDUTL("Task #"_ZTSK_" created. An email will be sent to holders of the ECMGR") D MES^XPDUTL("key upon completion.")
I '$G(ZTSK) D MES^XPDUTL("Task not created! Contact customer support for assistance!")
Q
ADDREAS ;List of new procedure reasons
;;CHAP ACUTE/SUBACUTE MH
;;CHAP CBOC
;;CHAP CLC
;;CHAP CONSULTS
;;CHAP CRITICAL CARE
;;CHAP ETHICS
;;CHAP GERO PSYCH
;;CHAP GRAND ROUNDS
;;CHAP HEM/ONC
;;CHAP HOME BASED PRIMARY CARE
;;CHAP HOMELESS
;;CHAP HOSPICE
;;CHAP IDT MEETING
;;CHAP MED/SURG UNIT[S]
;;CHAP MHICM
;;CHAP OIF/OEF/OND
;;CHAP PALLIATIVE
;;CHAP POLYTRAUMA
;;CHAP PRRP
;;CHAP PTSD
;;CHAP REHABILITATION
;;CHAP SAME DAY SURG
;;CHAP SPINAL CORD INJURY
;;CHAP SUBSTANCE USE DISORDER
;;CHAP TBI
;;CHAP TEAM ROUNDS
;;CHAP TELEHEALTH
;;CHAP WOMEN'S HEALTH CLINIC
;;CHAP INTERN
;;CHAP RESIDENT
;;CHAP FELLOW
;;CHAP SPVR TRNG
;;QUIT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEC2P122 2832 printed Apr 09, 2024@21:04:05 Page 2
EC2P122 ;ALB/DAN Post-install events for Event Capture patch 122 ;2/5/14 16:42
+1 ;;2.0;EVENT CAPTURE;**122**;8 May 96;Build 2
+2 ;
POST ;Come here for post-install actions
+1 ;Add new procedure reasons to the procedure reasons file
DO ADDNEW
+2 ;Inactivate event code screens with inactive procedure codes
DO INACT
+3 QUIT
+4 ;
ADDNEW ;Add new entry to file 720.4
+1 ;
+2 NEW ECXFDA,ECXERR,ECREAS,I
+3 ;
+4 ;-get procedure reason
+5 FOR I=1:1
SET ECREAS=$PIECE($TEXT(ADDREAS+I),";;",2)
if ECREAS="QUIT"
QUIT
Begin DoDot:1
+6 ;
+7 ;-quit w/error message if entry already exists in file #720.4
+8 IF $$FIND1^DIC(720.4,"","X",ECREAS)
Begin DoDot:2
+9 DO BMES^XPDUTL(">>>..."_ECREAS_" not added, entry already exists.")
End DoDot:2
QUIT
+10 ;
+11 ;Setup field values of new entry
+12 SET ECXFDA(720.4,"+1,",.01)=ECREAS
+13 ;Set "ACTIVE?" field to 1 (active)
SET ECXFDA(720.4,"+1,",.02)=1
+14 ;
+15 ;-add new entry to file #720.4
+16 DO UPDATE^DIE("E","ECXFDA","","ECXERR")
+17 ;
+18 IF '$DATA(ECXERR)
DO BMES^XPDUTL(">>>...."_ECREAS_" added to file.")
+19 IF $DATA(ECXERR)
DO BMES^XPDUTL(">>>....Unable to add "_ECREAS_" to file.")
End DoDot:1
+20 ;
+21 QUIT
+22 ;
INACT ;Find inactive event code screens with inactive procedure codes
+1 NEW DAYS,ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK
+2 ;Event code screen clean up happens in 3 days if installed in test, 30 days if in production
SET DAYS=$SELECT($$PROD^XUPROD:30,1:3)
+3 DO BMES^XPDUTL("Identifying event code screens with inactive EC Procedure Codes.")
DO MES^XPDUTL("A list of findings will be emailed to holders of the ECMGR key.")
+4 ;Start scanning event code screens in "report only" mode
DO INACTSCR^ECUTL3(0)
+5 DO BMES^XPDUTL("Any event code screens with inactive EC Procedure Codes will be")
DO MES^XPDUTL("automatically inactivated "_DAYS_" days from now. Creating background task")
DO MES^XPDUTL("for this process.")
+6 SET ZTRTN="INACTSCR^ECUTL3(1)"
SET ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,DAYS)
SET ZTIO=""
SET ZTDESC="Inactivation of event code screens with inactive EC Procedure Codes"
DO ^%ZTLOAD
+7 IF $GET(ZTSK)
DO BMES^XPDUTL("Task #"_ZTSK_" created. An email will be sent to holders of the ECMGR")
DO MES^XPDUTL("key upon completion.")
+8 IF '$GET(ZTSK)
DO MES^XPDUTL("Task not created! Contact customer support for assistance!")
+9 QUIT
ADDREAS ;List of new procedure reasons
+1 ;;CHAP ACUTE/SUBACUTE MH
+2 ;;CHAP CBOC
+3 ;;CHAP CLC
+4 ;;CHAP CONSULTS
+5 ;;CHAP CRITICAL CARE
+6 ;;CHAP ETHICS
+7 ;;CHAP GERO PSYCH
+8 ;;CHAP GRAND ROUNDS
+9 ;;CHAP HEM/ONC
+10 ;;CHAP HOME BASED PRIMARY CARE
+11 ;;CHAP HOMELESS
+12 ;;CHAP HOSPICE
+13 ;;CHAP IDT MEETING
+14 ;;CHAP MED/SURG UNIT[S]
+15 ;;CHAP MHICM
+16 ;;CHAP OIF/OEF/OND
+17 ;;CHAP PALLIATIVE
+18 ;;CHAP POLYTRAUMA
+19 ;;CHAP PRRP
+20 ;;CHAP PTSD
+21 ;;CHAP REHABILITATION
+22 ;;CHAP SAME DAY SURG
+23 ;;CHAP SPINAL CORD INJURY
+24 ;;CHAP SUBSTANCE USE DISORDER
+25 ;;CHAP TBI
+26 ;;CHAP TEAM ROUNDS
+27 ;;CHAP TELEHEALTH
+28 ;;CHAP WOMEN'S HEALTH CLINIC
+29 ;;CHAP INTERN
+30 ;;CHAP RESIDENT
+31 ;;CHAP FELLOW
+32 ;;CHAP SPVR TRNG
+33 ;;QUIT
