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

TIUP290A.m

Go to the documentation of this file.
  1. TIUP290A ;ISP/JLC - POST FOR PATCH TIU*1.0*290 ;Apr 24, 2020@13:48
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**290**;Jun 20, 1997;Build 548
  1. Q
  1. EN ; Task off the Build of the Copy/Paste indices for file #8925
  1. N ZTDTH,ZTIO,ZTSK,ZTRTN,ZTDESC
  1. S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,0,10)
  1. S ZTRTN="TASK^TIUP290A",ZTDESC="Build of Copy/Paste indices for files #8925 and #8925.95"
  1. S ZTIO=""
  1. D ^%ZTLOAD
  1. I +$G(ZTSK)=0 D
  1. . D BMES^XPDUTL("Unable to queue the Copy/Paste indices build, file a help desk ticket for assistance.")
  1. E D
  1. . D BMES^XPDUTL("DONE - Task #"_ZTSK)
  1. Q
  1. TASK ;
  1. N TIUIEN,I,J,STOP,A,TIU12,TIU13,TIUDOC
  1. S STOP=0
  1. K ^TIU(8925.95,"AC") ; Clean-up index due to falty cross-reference setup
  1. K DA,DIK,DIC
  1. S TIUDOC=""
  1. F S TIUDOC=$O(^TIU(8925.95,TIUDOC)) Q:TIUDOC="" D
  1. . I $P($G(^TIU(8925.95,TIUDOC,10)),U,1)'=1 Q
  1. . S DA=TIUDOC,DIK="^TIU(8925.95,",DIK(1)="10.1^AC"
  1. . D EN^DIK
  1. S TIUIEN=$G(^TIU(8925,"AADT",0)) I TIUIEN="" S TIUIEN=" "
  1. F I=1:1 D Q:'TIUIEN I STOP Q
  1. . S TIUIEN=$O(^TIU(8925,TIUIEN),-1) Q:'TIUIEN
  1. . S TIU12=$G(^TIU(8925,TIUIEN,12))
  1. . S TIU13=$G(^TIU(8925,TIUIEN,13))
  1. . S X(1)=$P(TIU12,"^",2),X(2)=$P(TIU13,"^",2),X(3)=$P(TIU13,"^")
  1. . S DA=TIUIEN
  1. . D KAADT^TIUDD01(.X)
  1. . D SAADT^TIUDD0(.X)
  1. . K DA,DIK,DIC
  1. . S DA=TIUIEN,DIK="^TIU(8925,",DIK(1)="1301^H"
  1. . D EN^DIK
  1. . S ^TIU(8925,"AADT",0)=TIUIEN
  1. . I '(I#100000) D I STOP Q
  1. .. F J=1:1:300 H 1 I '(J#60) S STOP=$$REQ2STOP() I STOP Q
  1. . I '(I#500) S STOP=$$REQ2STOP() I STOP Q
  1. I STOP Q
  1. K ^TIU(8925,"AADT",0)
  1. D MSG
  1. Q
  1. MSG ;
  1. N XMSUB,XMY,XMTEXT,XMDUZ,TIUTEXT,SITE,I,A
  1. S TIUTEXT(1)="Build of Copy/Paste indicess completed for "_$$SITE^VASITE()
  1. S TIUTEXT(2)=" "
  1. S XMDUZ=DUZ
  1. S XMSUB="Build of Copy/Paste indicess completed"
  1. S XMY("CRUMLEY.JAMIE@DOMAIN.EXT")="",XMY("HAWSEY.JASON@DOMAIN.EXT")=""
  1. S XMTEXT="TIUTEXT("
  1. D ^XMD
  1. Q
  1. REQ2STOP() ;
  1. ; Check for task stop request
  1. ; Returns 1 if stop request made.
  1. N STATUS,X
  1. S STATUS=0
  1. I '$D(ZTQUEUED) Q 0
  1. S X=$$S^%ZTLOAD()
  1. I X D ;
  1. . S STATUS=1
  1. . S X=$$S^%ZTLOAD("Received shutdown request")
  1. ;
  1. Q STATUS
  1. TEMPLATE ;post-install to check line length in templates
  1. N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTSK
  1. D BMES^XPDUTL(" Queueing the template checker task...")
  1. S ZTRTN="CHECK^TIUP290A",ZTDESC="TIU*1*290 TEMPLATE CHECKER"
  1. S ZTDTH=$$FMADD^XLFDT($$NOW^XLFDT,0,0,2),ZTIO=""
  1. D ^%ZTLOAD
  1. I +$G(ZTSK)>0 D MES^XPDUTL(" Successfully queued the task with task #"_ZTSK)
  1. I '+$G(ZTSK) D MES^XPDUTL(" Failed to queue the task"),CHECK
  1. Q
  1. CHECK ;check the length of template text
  1. N ROOTIEN,LINE,NEXTSTOP,ROOT,OUTPUTHEADER,HEADER,PATH,OUTPUTPATH
  1. S LINE=0
  1. F ROOT="CONSULTS","PROCEDURES" D
  1. .S ROOTIEN=+$O(^TIU(8927,"AROOT",ROOT,"")) Q:ROOTIEN=0
  1. .S OUTPUTHEADER=1,OUTPUTPATH=0,PATH=""
  1. .S HEADER=$P($G(^TIU(8927,ROOTIEN,0)),U,1) I HEADER="" S HEADER=ROOT
  1. .D CHILDREN(ROOTIEN,.NEXTSTOP,.ZTSTOP,.LINE,.OUTPUTHEADER,HEADER,.PATH,.OUTPUTPATH)
  1. K:+$G(ZTSTOP)=0 ZTSTOP
  1. I +$G(ZTSTOP)=1 D
  1. .S LINE=1,^TMP("TIU MSG",$J,LINE,0)="Task #"_$G(ZTSK)_" was stopped before it finished."
  1. .S LINE=LINE+1,^TMP("TIU MSG",$J,LINE,0)="Restart the task or execute D TEMPLATE^TIUP290A from the Programmer's"
  1. .S LINE=LINE+1,^TMP("TIU MSG",$J,LINE,0)="prompt to restart the template checker."
  1. I '+$G(LINE) D
  1. .K ^TMP("TIU MSG",$J)
  1. .S LINE=1,^TMP("TIU MSG",$J,LINE,0)="There are no templates containing text that is more than 74 characters in"
  1. .S LINE=LINE+1,^TMP("TIU MSG",$J,LINE,0)="length."
  1. N XMMG,XMDUZ,XMZ,XMERR,DIFROM,XMTEXT,XMSUB,XMY
  1. S XMDUZ="TIU TEMPLATE CHECKER",XMSUB="TIU*1*290 TEMPLATE CHECK RESULTS"
  1. S XMTEXT="^TMP(""TIU MSG"",$J,"
  1. S XMY(DUZ)="",XMY("G.OR CACS")=""
  1. D ^XMD
  1. I $D(XMMG)>0 D
  1. .M ^XTMP("TIU*1*290 TEMPLATE CHECK RESULTS")=^TMP("GMRA MSG",$J)
  1. .S ^XTMP("TIU*1*290 TEMPLATE CHECK RESULTS",0)=$$FMADD^XLFDT(DT,31)_U_DT_U_"PATCH TIU*1*290 TEMPLATE CHECK RESULTS"
  1. K ^TMP("TIU MSG",$J)
  1. I $D(ZTQUEUED),'$D(ZTSTOP) S ZTREQ="@"
  1. I '$D(ZTQUEUED) D MES^XPDUTL(" Template checker process has exited")
  1. Q
  1. CHILDREN(ROOTIEN,NEXTSTOP,ZTSTOP,LINE,OUTPUTHEADER,HEADER,PATH,OUTPUTPATH) ;recursively search templates
  1. N ITEMIEN,IEN,NAME,G74,START,CNT,NODE
  1. S ITEMIEN=0 F S ITEMIEN=$O(^TIU(8927,ROOTIEN,10,ITEMIEN)) Q:('+ITEMIEN)!($G(ZTSTOP)) D
  1. .I $G(NEXTSTOP)=""!($G(NEXTSTOP)=$H) D
  1. ..S ZTSTOP=$$S^%ZTLOAD Q:ZTSTOP
  1. ..S NEXTSTOP=$$HADD^XLFDT($H,0,0,0,30)
  1. .Q:ZTSTOP
  1. .S IEN=+$P($G(^TIU(8927,ROOTIEN,10,ITEMIEN,0)),U,2) Q:'IEN
  1. .S NODE=$G(^TIU(8927,IEN,0))
  1. .S NAME=$P(NODE,U,1) Q:NAME=""
  1. .I $P(NODE,U,3)="C" S PATH=$S($G(PATH)'="":PATH_" > ",1:"")_NAME,OUTPUTPATH=1
  1. .S G74=0,START=0
  1. .S CNT=0 F S CNT=$O(^TIU(8927,IEN,2,CNT)) Q:(CNT'>0)!(G74=1) D
  1. ..S NODE=$G(^TIU(8927,IEN,2,CNT,0))
  1. ..D STRIPFIELDS(.NODE,.START)
  1. ..I $L(NODE)>74 S G74=1
  1. .I G74 D ADDTEMPLATE(.LINE,.OUTPUTPATH,.PATH,NAME,.OUTPUTHEADER,HEADER)
  1. .I $D(^TIU(8927,IEN,10))>9 D CHILDREN(IEN,.NEXTSTOP,.ZTSTOP,.LINE,.OUTPUTHEADER,HEADER,.PATH,.OUTPUTPATH)
  1. Q
  1. STRIPFIELDS(TEXT,START) ;remove template field(s) from text
  1. N INDEX,THIS,SPEC,SEARCH
  1. S THIS=0
  1. F INDEX=1:1 Q:INDEX>$L(TEXT) D
  1. .I ($E(TEXT,INDEX,INDEX+4)="{FLD:")!(($E(TEXT,INDEX)="|")&(START=0)) S START=START+1,START(START)=INDEX,THIS=1 Q
  1. .I (($E(TEXT,INDEX)="}")!($E(TEXT,INDEX)="|"))&(+$G(START)>0) D
  1. ..S SEARCH=$E(TEXT,$S(THIS=1:START(START),1:1),INDEX),SPEC(SEARCH)=""
  1. ..S TEXT=$$REPLACE^XLFSTR(TEXT,.SPEC),INDEX=INDEX-$L(SEARCH)
  1. ..K SPEC,START(START)
  1. ..S START=START-1
  1. I START>0 D
  1. .I THIS S SPEC($E(TEXT,START(START),$L(TEXT)))="",TEXT=$$REPLACE^XLFSTR(TEXT,.SPEC)
  1. .E S TEXT=""
  1. Q
  1. ADDTEMPLATE(LINE,OUTPUTPATH,PATH,NAME,OUTPUTHEADER,HEADER) ;add a template to the message body
  1. I '+$G(LINE) D
  1. .K ^TMP("TIU MSG",$J)
  1. .S LINE=1,^TMP("TIU MSG",$J,LINE,0)="The following templates contain text that is more than 74 characters in"
  1. .S LINE=LINE+1,^TMP("TIU MSG",$J,LINE,0)="length. Please review each template in CPRS to ensure that the text is"
  1. .S LINE=LINE+1,^TMP("TIU MSG",$J,LINE,0)="wrapped correctly."
  1. .S LINE=LINE+1,^TMP("TIU MSG",$J,LINE,0)=""
  1. I OUTPUTHEADER D
  1. .I LINE>3 S LINE=LINE+1,^TMP("TIU MSG",$J,LINE,0)=""
  1. .S LINE=LINE+1,^TMP("TIU MSG",$J,LINE,0)=HEADER
  1. .S LINE=LINE+1,^TMP("TIU MSG",$J,LINE,0)=$$REPEAT^XLFSTR("-",$L(HEADER))
  1. .S OUTPUTHEADER=0
  1. I OUTPUTPATH S LINE=LINE+1,^TMP("TIU MSG",$J,LINE,0)=PATH,OUTPUTPATH=0
  1. I PATH'="" S NAME=" "_NAME
  1. S LINE=LINE+1,^TMP("TIU MSG",$J,LINE,0)=NAME
  1. Q