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