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

OR556PST.m

Go to the documentation of this file. 
  1. OR556PST ;HPS/DSK - OR*3.0*556 PATCH POST INSTALL ROUTINE; May 24, 2021@16:38
  1.  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**556**;Dec 17, 1997;Build 6
  1.  ;
  1.  Q
  1.  ;
  1. EN ;
  1.  ;This routine is not deleted after install since it is tasked. A future
  1.  ;patch will delete the routine.
  1.  ;
  1.  N ORDUZ
  1.  S ZTRTN="START^OR556PST"
  1.  S ZTDESC="OR*3.0*556 Post-Install Routine"
  1.  S ZTIO="",ZTDTH=$H
  1.  S ORDUZ=DUZ
  1.  S ZTSAVE("ORDUZ")=""
  1.  D ^%ZTLOAD
  1.  W !!,"OR*3.0*556 Post-Install Routine has been tasked - TASK NUMBER: ",$G(ZTSK)
  1.  W !!,"You as well as members of the OR CACS MailMan Groups will receive"
  1.  W !,"a MailMan message when the search completes.",!
  1.  Q
  1.  ;
  1. START ;
  1.  N ORDLG,ORDSTR,ORPRMPT,ORSEQ,ORPRX,ORID,ORPRSTR,ORARR,ORIGNORE,ORSPACE,ORCOUNT
  1.  K ^XTMP("OR*3.0*556 MAILMAN MESSAGE")
  1.  S $P(ORSPACE," ",45)=" "
  1.  S ORIGNORE("PSJI OR PAT FLUID OE")=""
  1.  S ORIGNORE("CLINIC OR PAT FLUID OE")=""
  1.  S ORIGNORE("FHW OP MEAL")=""
  1.  S (ORCOUNT,ORDLG)=0,ORSEQ=18
  1.  F  S ORDLG=$O(^ORD(101.41,ORDLG)) Q:'ORDLG  D
  1.  . S ORDSTR=$G(^ORD(101.41,ORDLG,0))
  1.  . ;The first piece which is "NAME" should not be null.
  1.  . ;But checking anyway.
  1.  . Q:$P(ORDSTR,"^")=""
  1.  . ;Do not include "ZZ" dialogs since no longer in use.
  1.  . Q:$E(ORDSTR,1,2)="ZZ"
  1.  . ;Do not include three order dialogs which appear to
  1.  . ;have been nationally released years ago and are
  1.  . ;causing no problems
  1.  . Q:$D(ORIGNORE($P(ORDSTR,"^")))
  1.  . ;only scanning type "Dialog"
  1.  . Q:$P(ORDSTR,"^",4)'="D"
  1.  . K ORARR
  1.  . S ORPRMPT=0
  1.  . F  S ORPRMPT=$O(^ORD(101.41,ORDLG,10,ORPRMPT)) Q:'ORPRMPT  D
  1.  . . S ORPRX=$P($G(^ORD(101.41,ORDLG,10,ORPRMPT,0)),"^",2)
  1.  . . Q:ORPRX=""
  1.  . . S ORPRSTR=$G(^ORD(101.41,ORPRX,0))
  1.  . . ;Should be type "P", but check to be sure.
  1.  . . Q:$P(ORPRSTR,"^",4)'="P"
  1.  . . S ORID=$P($G(^ORD(101.41,ORPRX,1)),"^",3)
  1.  . . I ORID]"" D
  1.  . . . S ORARR(ORID)=$G(ORARR(ORID))+1
  1.  . . . S ORARR(ORID,ORPRMPT)=$P(ORPRSTR,"^")
  1.  . ;Do any prompts share the same ID?
  1.  . S ORID=""
  1.  . F  S ORID=$O(ORARR(ORID)) Q:ORID=""  I ORARR(ORID)>1 D
  1.  . . N ORSTR
  1.  . . S ORCOUNT=ORCOUNT+1
  1.  . . S ORSEQ=ORSEQ+1
  1.  . . S ORSTR=$E($P($G(^ORD(101.41,ORDLG,0)),"^"),1,24)
  1.  . . S ORSTR=ORSTR_$E(ORSPACE,1,26-$L(ORSTR))
  1.  . . S ORSTR=ORSTR_$E(ORID,1,15)_"  "
  1.  . . S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",ORSEQ)=ORSTR
  1.  . . S ORPRX=$O(ORARR(ORID,""))
  1.  . . D SET
  1.  . . F  S ORPRX=$O(ORARR(ORID,ORPRX)) Q:ORPRX=""  D
  1.  . . . S ORSEQ=ORSEQ+1
  1.  . . . D SET
  1.  D XTMP,MAIL
  1.  Q
  1.  ;
  1. SET ;
  1.  N ORSTR,ORNAMPR
  1.  S ORSTR=$G(^XTMP("OR*3.0*556 MAILMAN MESSAGE",ORSEQ))
  1.  S ORNAMPR=ORARR(ORID,ORPRX)_" (#"_ORPRX_")"
  1.  S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",ORSEQ)=$G(^XTMP("OR*3.0*556 MAILMAN MESSAGE",ORSEQ))_$E(ORSPACE,1,43-$L(ORSTR))
  1.  S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",ORSEQ)=^XTMP("OR*3.0*556 MAILMAN MESSAGE",ORSEQ)_$E(ORNAMPR,1,32)
  1.  Q
  1.  ;
  1. XTMP ;Generate MailMan message and keep in ^XTMP for 60 days
  1.  S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",0)=$$FMADD^XLFDT(DT,60)_"^"_DT_"^OR*3.0*556 POST INSTALL"
  1.  S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",1)=" "
  1.  S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",2)="OR*3.0*556 post-install routine found "_$S(ORCOUNT=0:"no",1:(ORCOUNT))_" entries in the ORDER DIALOG"
  1.  S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",3)="(#101.41) file with more than one prompt defined for the same ID."
  1.  I ORSEQ>18 D
  1.  . S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",4)="Listed below are such entries which should be reviewed to determine"
  1.  . S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",5)="if any prompts should be edited to have a different ID or replaced"
  1.  . S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",6)="with new prompts."
  1.  . S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",7)=" "
  1.  . S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",8)="If your site has not experienced problems with these order dialogs,"
  1.  . S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",9)="changes are probably not necessary."
  1.  . S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",10)=" "
  1.  . S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",11)="If the ID on an existing prompt does need to be changed, make sure"
  1.  . S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",12)="the prompt does not exist on another order dialog and will now have"
  1.  . S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",13)="the same ID as another prompt. The safest method is to create a new"
  1.  . S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",14)="prompt with a different ID. Then replace the existing prompt with"
  1.  . S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",15)="the new prompt."
  1.  . S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",16)=" "
  1.  . S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",17)="Order Dialog              ID               Prompt (#IEN)"
  1.  . S ^XTMP("OR*3.0*556 MAILMAN MESSAGE",18)="------------------------  ---------------  --------------------------------"
  1.  Q
  1.  ;
  1. MAIL ;
  1.  N ORMIN,ORMY,ORMSUB,ORMTEXT
  1.  S ORMIN("FROM")="OR*3.0*556 Post-Install"
  1.  S ORMY(ORDUZ)=""
  1.  S ORMY("G.OR CACS")=""
  1.  S ORMSUB="OR*3.0*556 Post-Install"
  1.  S ORMTEXT="^XTMP(""OR*3.0*556 MAILMAN MESSAGE"")"
  1.  D SENDMSG^XMXAPI(DUZ,ORMSUB,ORMTEXT,.ORMY,.ORMIN,"","")
  1.  Q