- EC2P131 ;ALB/DAN Post-Install events for Event Capture patch 131 ;10/27/15 16:08
- ;;2.0;EVENT CAPTURE;**131**;8 May 96;Build 13
- ;
- POST ;Called from build to do post-install events
- N UPDATE
- D CHKPCE
- D MAIL
- D CHKDSS^ECUTL3
- D REASON
- Q
- ;
- CHKPCE ;Change any DSS units that have SEND TO PCE set to "O" to "A"
- N IEN,DSSU
- S IEN=0 F S IEN=$O(^ECD(IEN)) Q:'+IEN S DSSU=$G(^ECD(IEN,0)) I $P(DSSU,U,14)="O" S $P(^ECD(IEN,0),U,14)="A",UPDATE($P(DSSU,U)_U_IEN_U_$S('$P(DSSU,U,6):"Active",1:"Inactive"))=""
- Q
- ;
- MAIL ;Send findings 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 'Outpatient Only'"
- S ECTEXT(2)="has completed. Below are the results."
- S ECTEXT(3)=""
- I '$D(UPDATE) S ECTEXT(4)="No DSS Units were identified. No further action is required."
- S CNT=4 ;start with line 4 to add to message
- I $D(UPDATE) D
- .S ECTEXT(CNT)="The following DSS Units had their Send to PCE setting changed to 'All Records':",CNT=CNT+1,ECTEXT(CNT)="",CNT=CNT+1
- .S ECTEXT(CNT)="NAME"_$$REPEAT^XLFSTR(" ",28)_"DSS IEN STATUS",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)_$$REPEAT^XLFSTR(" ",(9-$L($P(NAME,U,2))))_$P(NAME,U,3),CNT=CNT+1
- S XMTEXT="ECTEXT(",XMSUB="DSS Unit send to PCE review"
- D ^XMD ;Send email
- Q
- ;
- REASON ;Add entries in file 720.4
- ;
- N ECXFDA,ECXERR,ECREAS,I,DONE,IEN,FDA
- ;
- ;-add 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
- ;
- ADDREAS ;List of new procedure reasons
- ;;CHAP COUPLES COUNSELING
- ;;QUIT
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEC2P131 2552 printed Feb 18, 2025@23:21:17 Page 2
- EC2P131 ;ALB/DAN Post-Install events for Event Capture patch 131 ;10/27/15 16:08
- +1 ;;2.0;EVENT CAPTURE;**131**;8 May 96;Build 13
- +2 ;
- POST ;Called from build to do post-install events
- +1 NEW UPDATE
- +2 DO CHKPCE
- +3 DO MAIL
- +4 DO CHKDSS^ECUTL3
- +5 DO REASON
- +6 QUIT
- +7 ;
- CHKPCE ;Change any DSS units that have SEND TO PCE set to "O" to "A"
- +1 NEW IEN,DSSU
- +2 SET IEN=0
- FOR
- SET IEN=$ORDER(^ECD(IEN))
- if '+IEN
- QUIT
- SET DSSU=$GET(^ECD(IEN,0))
- IF $PIECE(DSSU,U,14)="O"
- SET $PIECE(^ECD(IEN,0),U,14)="A"
- SET UPDATE($PIECE(DSSU,U)_U_IEN_U_$SELECT('$PIECE(DSSU,U,6):"Active",1:"Inactive"))=""
- +3 QUIT
- +4 ;
- MAIL ;Send findings via email
- +1 NEW XMSUB,ECTEXT,XMDUZ,XMY,XMZ,XMTEXT,KIEN,DIFROM,NAME,CNT
- +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 ECTEXT(1)="The check for DSS Units with a Send to PCE setting of 'Outpatient Only'"
- +6 SET ECTEXT(2)="has completed. Below are the results."
- +7 SET ECTEXT(3)=""
- +8 IF '$DATA(UPDATE)
- SET ECTEXT(4)="No DSS Units were identified. No further action is required."
- +9 ;start with line 4 to add to message
- SET CNT=4
- +10 IF $DATA(UPDATE)
- Begin DoDot:1
- +11 SET ECTEXT(CNT)="The following DSS Units had their Send to PCE setting changed to 'All Records':"
- SET CNT=CNT+1
- SET ECTEXT(CNT)=""
- SET CNT=CNT+1
- +12 SET ECTEXT(CNT)="NAME"_$$REPEAT^XLFSTR(" ",28)_"DSS IEN STATUS"
- SET CNT=CNT+1
- SET ECTEXT(CNT)="----"_$$REPEAT^XLFSTR(" ",28)_"------- ------"
- SET CNT=CNT+1
- +13 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)_$$REPEAT^XLFSTR(" ",(9-$LENGTH($PIECE(NAME,U,2))))_$PIECE(NAME,U,3)
- SET CNT=CNT+1
- End DoDot:1
- +14 SET XMTEXT="ECTEXT("
- SET XMSUB="DSS Unit send to PCE review"
- +15 ;Send email
- DO ^XMD
- +16 QUIT
- +17 ;
- REASON ;Add entries in file 720.4
- +1 ;
- +2 NEW ECXFDA,ECXERR,ECREAS,I,DONE,IEN,FDA
- +3 ;
- +4 ;-add 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 ;
- ADDREAS ;List of new procedure reasons
- +1 ;;CHAP COUPLES COUNSELING
- +2 ;;QUIT
- +3 ;
