EC2P145 ;ALB/DAN - Installation activities ;9/18/18 15:20
;;2.0;EVENT CAPTURE;**145**;8 May 96;Build 6
;
POST ;Post-install activities
D SERUPD ;Add medical specialty/service
D CHKLOC ;Check location names to see if they're correct
D DELLOC ;Del "LOC" xref and then rebuild so it uses current names
D GHOST ;Identify "ghost" DSS units (missing status)
Q
;
SERUPD ;Section will add new values to the Medical Specialty file
N NAME,CODE,OFF,NUM,DO,DIC,X,Y
D BMES^XPDUTL("Checking Medical Specialty file..."),MES^XPDUTL("")
F OFF=1:1 S CODE=$P($T(SERVICE+OFF),";;",2) Q:CODE="DONE" D
.S NAME=$P(CODE,U)
.S NUM=$$FIND1^DIC(723,,"X",NAME,"B")
.I NUM D MES^XPDUTL("Medical Specialty: "_NAME_" already exists.") Q
.K DO
.S DIC="^ECC(723,"
.S DIC(0)=""
.S X=NAME
.D FILE^DICN
.D MES^XPDUTL("Medical Specialty: "_NAME_" was "_$S(Y:"",1:"NOT ")_"added.")
.Q
Q
;
CHKLOC ;Check "LOC" index against actual names and report differences
N NAME,REC,CHG,DEL,NEWNM
S NAME="" F S NAME=$O(^DIC(4,"LOC",NAME)) Q:NAME="" D
.S REC=0 F S REC=$O(^DIC(4,"LOC",NAME,REC)) Q:'+REC D
..I '$D(^DIC(4,REC)) S DEL(NAME,REC)="" Q
..S NEWNM=$P($G(^DIC(4,REC,0)),U) ;Current name of location
..I NEWNM'=NAME S CHG(NAME,REC)=NEWNM ;Note name change
D MAIL
Q
;
DELLOC ;Fix "LOC" table in file 4
N DIK
D BMES^XPDUTL("Deleting 'LOC' cross-reference in file 4...")
K ^DIC(4,"LOC") ;One-time IA 6723 allows for this deletion
D MES^XPDUTL("Done")
D BMES^XPDUTL("Rebuilding 'LOC' cross-reference in file 4")
S DIK="^DIC(4,",DIK(1)=720 D ENALL^DIK
D MES^XPDUTL("Done")
Q
;
GHOST ;Finds DSS units that are missing their status. Missing status causes unit to appear in some lists, but not others, like a "ghost"
N NODE,GHOST,DSSIEN
D BMES^XPDUTL("Checking DSS Units for correct setup...")
S DSSIEN=0 F S DSSIEN=$O(^ECD(DSSIEN)) Q:'+DSSIEN D
.S NODE=$G(^ECD(DSSIEN,0)) Q:NODE=""
.I $P(NODE,U,6)=""&($P(NODE,U,8)="") D
..I $P(NODE,U)=$$GET1^DIQ(509850.8,"1,",727.8251)!($P(NODE,U)=$$GET1^DIQ(509850.8,"1,",727.8252)) Q ;Don't update audiology and speech pathology DSS units
..S GHOST($P(NODE,U))=DSSIEN
..S $P(^ECD(DSSIEN,0),U,6)=1 ;Set status to inactive
..S $P(^ECD(DSSIEN,0),U,8)=1 ;Set 'use in event capture' to 1 (yes)
..Q
.Q
D BMES^XPDUTL("Done")
D MAIL2
Q
;
MAIL ;Send email with results to holders of the ECMGR key
N XMSUB,XMTEXT,XMDUZ,XMY,XMZ,CNT,DIFROM,ECTEXT,NUM,NAME
S XMDUZ="PATCH EC*2*145 POST-INSTALL"
D GETXMY("ECMGR",.XMY)
S CNT=1
S ECTEXT(CNT)="A review of Event Capture Location names has completed.",CNT=CNT+1,ECTEXT(CNT)="Event Capture Location names were checked to make sure they are using the",CNT=CNT+1
S ECTEXT(CNT)="correct name as found in the INSTITUTION file (#4).",CNT=CNT+1
S ECTEXT(CNT)="",CNT=CNT+1
I '$D(CHG),'$D(DEL) S ECTEXT(CNT)="No differences were found between your Event Capture Locations and the",CNT=CNT+1,ECTEXT(CNT)="INSTITUTION file. No further action is required.",CNT=CNT+1
I $D(CHG)!($D(DEL)) D
.S ECTEXT(CNT)="Changes to your Event Capture Location names were required.",CNT=CNT+1
.S ECTEXT(CNT)="Entries are identified by NAME(IEN), where IEN is the record number in the",CNT=CNT+1
.S ECTEXT(CNT)="INSTITUTION file (file #4).",CNT=CNT+1
.S ECTEXT(CNT)="",CNT=CNT+1
I $D(CHG) D S ECTEXT(CNT)="",CNT=CNT+1
.S ECTEXT(CNT)="The following locations had their name updated:",CNT=CNT+1,ECTEXT(CNT)="",CNT=CNT+1
.S NAME="" F S NAME=$O(CHG(NAME)) Q:NAME="" S NUM=0 F S NUM=$O(CHG(NAME,NUM)) Q:'+NUM D
..S ECTEXT(CNT)=NAME_" ("_NUM_") is now "_$G(CHG(NAME,NUM)),CNT=CNT+1
I $D(DEL) D S ECTEXT(CNT)="",CNT=CNT+1
.S ECTEXT(CNT)="The following locations are no longer available:",CNT=CNT+1,ECTEXT(CNT)="",CNT=CNT+1
.S NAME="" F S NAME=$O(DEL(NAME)) Q:NAME="" S NUM=0 F S NUM=$O(DEL(NAME,NUM)) Q:'+NUM S ECTEXT(CNT)=NAME_" ("_NUM_") is no longer available.",CNT=CNT+1
I $D(CHG)!($D(DEL)) D
.S ECTEXT(CNT)="These updates were done to get your Event Capture Location names",CNT=CNT+1,ECTEXT(CNT)="back in sync with the INSTITUTION file. You should review your Event",CNT=CNT+1
.S ECTEXT(CNT)="Capture Locations to make sure that locations identified for use in Event",CNT=CNT+1,ECTEXT(CNT)="Capture are correct. No other action is required."
S XMTEXT="ECTEXT(",XMSUB="Event Capture Location review"
D ^XMD
Q
;
MAIL2 ;Send email with results of DSS unit review to ECMGR key holders
N XMSUB,XMTEXT,XMDUZ,XMY,XMZ,CNT,DIFROM,ECTEXT,NAME
S XMDUZ="PATCH EC*2*145 POST-INSTALL"
D GETXMY("ECMGR",.XMY)
S CNT=1
S ECTEXT(CNT)="A review of Event Capture DSS Units has completed.",CNT=CNT+1,ECTEXT(CNT)="DSS units were reviewed to ensure they're correctly set up for use",CNT=CNT+1
S ECTEXT(CNT)="in the Event Capture program.",CNT=CNT+1
S ECTEXT(CNT)="",CNT=CNT+1
I '$D(GHOST) S ECTEXT(CNT)="All DSS units are correctly set up.",CNT=CNT+1,ECTEXT(CNT)="",CNT=CNT+1,ECTEXT(CNT)="No further action is required.",CNT=CNT+1
I $D(GHOST) D
.S ECTEXT(CNT)="Changes to your DSS Units were required.",CNT=CNT+1,ECTEXT(CNT)="",CNT=CNT+1
.S ECTEXT(CNT)="Entries are identified by NAME(IEN), where IEN is the record number in the",CNT=CNT+1
.S ECTEXT(CNT)="DSS UNIT file (#724).",CNT=CNT+1
.S ECTEXT(CNT)="",CNT=CNT+1
.S ECTEXT(CNT)="The following DSS units were updated:",CNT=CNT+1,ECTEXT(CNT)="",CNT=CNT+1
.S NAME="" F S NAME=$O(GHOST(NAME)) Q:NAME="" S ECTEXT(CNT)=NAME_" ("_GHOST(NAME)_")",CNT=CNT+1
.S ECTEXT(CNT)="",CNT=CNT+1
.S ECTEXT(CNT)="Please review the DSS units listed above to ensure they're now inactive."
S XMTEXT="ECTEXT(",XMSUB="DSS Unit review"
D ^XMD
Q
;
GETXMY(KEY,XMY) ;Put holders of the KEY into the XMY array to be recipients of the email
I $G(KEY)'="" M XMY=^XUSEC(KEY)
S:$G(DUZ) XMY(DUZ)="" ;Make sure there's at least one recipient
Q
;
SERVICE ;List of new entries for the Medical Specialty file
;;VOCATIONAL REHABILITATION
;;DONE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEC2P145 5978 printed Dec 13, 2024@01:55:12 Page 2
EC2P145 ;ALB/DAN - Installation activities ;9/18/18 15:20
+1 ;;2.0;EVENT CAPTURE;**145**;8 May 96;Build 6
+2 ;
POST ;Post-install activities
+1 ;Add medical specialty/service
DO SERUPD
+2 ;Check location names to see if they're correct
DO CHKLOC
+3 ;Del "LOC" xref and then rebuild so it uses current names
DO DELLOC
+4 ;Identify "ghost" DSS units (missing status)
DO GHOST
+5 QUIT
+6 ;
SERUPD ;Section will add new values to the Medical Specialty file
+1 NEW NAME,CODE,OFF,NUM,DO,DIC,X,Y
+2 DO BMES^XPDUTL("Checking Medical Specialty file...")
DO MES^XPDUTL("")
+3 FOR OFF=1:1
SET CODE=$PIECE($TEXT(SERVICE+OFF),";;",2)
if CODE="DONE"
QUIT
Begin DoDot:1
+4 SET NAME=$PIECE(CODE,U)
+5 SET NUM=$$FIND1^DIC(723,,"X",NAME,"B")
+6 IF NUM
DO MES^XPDUTL("Medical Specialty: "_NAME_" already exists.")
QUIT
+7 KILL DO
+8 SET DIC="^ECC(723,"
+9 SET DIC(0)=""
+10 SET X=NAME
+11 DO FILE^DICN
+12 DO MES^XPDUTL("Medical Specialty: "_NAME_" was "_$SELECT(Y:"",1:"NOT ")_"added.")
+13 QUIT
End DoDot:1
+14 QUIT
+15 ;
CHKLOC ;Check "LOC" index against actual names and report differences
+1 NEW NAME,REC,CHG,DEL,NEWNM
+2 SET NAME=""
FOR
SET NAME=$ORDER(^DIC(4,"LOC",NAME))
if NAME=""
QUIT
Begin DoDot:1
+3 SET REC=0
FOR
SET REC=$ORDER(^DIC(4,"LOC",NAME,REC))
if '+REC
QUIT
Begin DoDot:2
+4 IF '$DATA(^DIC(4,REC))
SET DEL(NAME,REC)=""
QUIT
+5 ;Current name of location
SET NEWNM=$PIECE($GET(^DIC(4,REC,0)),U)
+6 ;Note name change
IF NEWNM'=NAME
SET CHG(NAME,REC)=NEWNM
End DoDot:2
End DoDot:1
+7 DO MAIL
+8 QUIT
+9 ;
DELLOC ;Fix "LOC" table in file 4
+1 NEW DIK
+2 DO BMES^XPDUTL("Deleting 'LOC' cross-reference in file 4...")
+3 ;One-time IA 6723 allows for this deletion
KILL ^DIC(4,"LOC")
+4 DO MES^XPDUTL("Done")
+5 DO BMES^XPDUTL("Rebuilding 'LOC' cross-reference in file 4")
+6 SET DIK="^DIC(4,"
SET DIK(1)=720
DO ENALL^DIK
+7 DO MES^XPDUTL("Done")
+8 QUIT
+9 ;
GHOST ;Finds DSS units that are missing their status. Missing status causes unit to appear in some lists, but not others, like a "ghost"
+1 NEW NODE,GHOST,DSSIEN
+2 DO BMES^XPDUTL("Checking DSS Units for correct setup...")
+3 SET DSSIEN=0
FOR
SET DSSIEN=$ORDER(^ECD(DSSIEN))
if '+DSSIEN
QUIT
Begin DoDot:1
+4 SET NODE=$GET(^ECD(DSSIEN,0))
if NODE=""
QUIT
+5 IF $PIECE(NODE,U,6)=""&($PIECE(NODE,U,8)="")
Begin DoDot:2
+6 ;Don't update audiology and speech pathology DSS units
IF $PIECE(NODE,U)=$$GET1^DIQ(509850.8,"1,",727.8251)!($PIECE(NODE,U)=$$GET1^DIQ(509850.8,"1,",727.8252))
QUIT
+7 SET GHOST($PIECE(NODE,U))=DSSIEN
+8 ;Set status to inactive
SET $PIECE(^ECD(DSSIEN,0),U,6)=1
+9 ;Set 'use in event capture' to 1 (yes)
SET $PIECE(^ECD(DSSIEN,0),U,8)=1
+10 QUIT
End DoDot:2
+11 QUIT
End DoDot:1
+12 DO BMES^XPDUTL("Done")
+13 DO MAIL2
+14 QUIT
+15 ;
MAIL ;Send email with results to holders of the ECMGR key
+1 NEW XMSUB,XMTEXT,XMDUZ,XMY,XMZ,CNT,DIFROM,ECTEXT,NUM,NAME
+2 SET XMDUZ="PATCH EC*2*145 POST-INSTALL"
+3 DO GETXMY("ECMGR",.XMY)
+4 SET CNT=1
+5 SET ECTEXT(CNT)="A review of Event Capture Location names has completed."
SET CNT=CNT+1
SET ECTEXT(CNT)="Event Capture Location names were checked to make sure they are using the"
SET CNT=CNT+1
+6 SET ECTEXT(CNT)="correct name as found in the INSTITUTION file (#4)."
SET CNT=CNT+1
+7 SET ECTEXT(CNT)=""
SET CNT=CNT+1
+8 IF '$DATA(CHG)
IF '$DATA(DEL)
SET ECTEXT(CNT)="No differences were found between your Event Capture Locations and the"
SET CNT=CNT+1
SET ECTEXT(CNT)="INSTITUTION file. No further action is required."
SET CNT=CNT+1
+9 IF $DATA(CHG)!($DATA(DEL))
Begin DoDot:1
+10 SET ECTEXT(CNT)="Changes to your Event Capture Location names were required."
SET CNT=CNT+1
+11 SET ECTEXT(CNT)="Entries are identified by NAME(IEN), where IEN is the record number in the"
SET CNT=CNT+1
+12 SET ECTEXT(CNT)="INSTITUTION file (file #4)."
SET CNT=CNT+1
+13 SET ECTEXT(CNT)=""
SET CNT=CNT+1
End DoDot:1
+14 IF $DATA(CHG)
Begin DoDot:1
+15 SET ECTEXT(CNT)="The following locations had their name updated:"
SET CNT=CNT+1
SET ECTEXT(CNT)=""
SET CNT=CNT+1
+16 SET NAME=""
FOR
SET NAME=$ORDER(CHG(NAME))
if NAME=""
QUIT
SET NUM=0
FOR
SET NUM=$ORDER(CHG(NAME,NUM))
if '+NUM
QUIT
Begin DoDot:2
+17 SET ECTEXT(CNT)=NAME_" ("_NUM_") is now "_$GET(CHG(NAME,NUM))
SET CNT=CNT+1
End DoDot:2
End DoDot:1
SET ECTEXT(CNT)=""
SET CNT=CNT+1
+18 IF $DATA(DEL)
Begin DoDot:1
+19 SET ECTEXT(CNT)="The following locations are no longer available:"
SET CNT=CNT+1
SET ECTEXT(CNT)=""
SET CNT=CNT+1
+20 SET NAME=""
FOR
SET NAME=$ORDER(DEL(NAME))
if NAME=""
QUIT
SET NUM=0
FOR
SET NUM=$ORDER(DEL(NAME,NUM))
if '+NUM
QUIT
SET ECTEXT(CNT)=NAME_" ("_NUM_") is no longer available."
SET CNT=CNT+1
End DoDot:1
SET ECTEXT(CNT)=""
SET CNT=CNT+1
+21 IF $DATA(CHG)!($DATA(DEL))
Begin DoDot:1
+22 SET ECTEXT(CNT)="These updates were done to get your Event Capture Location names"
SET CNT=CNT+1
SET ECTEXT(CNT)="back in sync with the INSTITUTION file. You should review your Event"
SET CNT=CNT+1
+23 SET ECTEXT(CNT)="Capture Locations to make sure that locations identified for use in Event"
SET CNT=CNT+1
SET ECTEXT(CNT)="Capture are correct. No other action is required."
End DoDot:1
+24 SET XMTEXT="ECTEXT("
SET XMSUB="Event Capture Location review"
+25 DO ^XMD
+26 QUIT
+27 ;
MAIL2 ;Send email with results of DSS unit review to ECMGR key holders
+1 NEW XMSUB,XMTEXT,XMDUZ,XMY,XMZ,CNT,DIFROM,ECTEXT,NAME
+2 SET XMDUZ="PATCH EC*2*145 POST-INSTALL"
+3 DO GETXMY("ECMGR",.XMY)
+4 SET CNT=1
+5 SET ECTEXT(CNT)="A review of Event Capture DSS Units has completed."
SET CNT=CNT+1
SET ECTEXT(CNT)="DSS units were reviewed to ensure they're correctly set up for use"
SET CNT=CNT+1
+6 SET ECTEXT(CNT)="in the Event Capture program."
SET CNT=CNT+1
+7 SET ECTEXT(CNT)=""
SET CNT=CNT+1
+8 IF '$DATA(GHOST)
SET ECTEXT(CNT)="All DSS units are correctly set up."
SET CNT=CNT+1
SET ECTEXT(CNT)=""
SET CNT=CNT+1
SET ECTEXT(CNT)="No further action is required."
SET CNT=CNT+1
+9 IF $DATA(GHOST)
Begin DoDot:1
+10 SET ECTEXT(CNT)="Changes to your DSS Units were required."
SET CNT=CNT+1
SET ECTEXT(CNT)=""
SET CNT=CNT+1
+11 SET ECTEXT(CNT)="Entries are identified by NAME(IEN), where IEN is the record number in the"
SET CNT=CNT+1
+12 SET ECTEXT(CNT)="DSS UNIT file (#724)."
SET CNT=CNT+1
+13 SET ECTEXT(CNT)=""
SET CNT=CNT+1
+14 SET ECTEXT(CNT)="The following DSS units were updated:"
SET CNT=CNT+1
SET ECTEXT(CNT)=""
SET CNT=CNT+1
+15 SET NAME=""
FOR
SET NAME=$ORDER(GHOST(NAME))
if NAME=""
QUIT
SET ECTEXT(CNT)=NAME_" ("_GHOST(NAME)_")"
SET CNT=CNT+1
+16 SET ECTEXT(CNT)=""
SET CNT=CNT+1
+17 SET ECTEXT(CNT)="Please review the DSS units listed above to ensure they're now inactive."
End DoDot:1
+18 SET XMTEXT="ECTEXT("
SET XMSUB="DSS Unit review"
+19 DO ^XMD
+20 QUIT
+21 ;
GETXMY(KEY,XMY) ;Put holders of the KEY into the XMY array to be recipients of the email
+1 IF $GET(KEY)'=""
MERGE XMY=^XUSEC(KEY)
+2 ;Make sure there's at least one recipient
if $GET(DUZ)
SET XMY(DUZ)=""
+3 QUIT
+4 ;
SERVICE ;List of new entries for the Medical Specialty file
+1 ;;VOCATIONAL REHABILITATION
+2 ;;DONE
