source: WorldVistAEHR/trunk/r/DATABASE_ADMIN_TOOLS-DBA/DBAKID2M.m@ 1604

Last change on this file since 1604 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.1 KB
RevLine 
[613]1DBAKID2M ; Restore patches from HFS files to MailMan ;9/28/02 12:53
2 ; Get path to HFS patches
3 ; Order through all messages
4 I '$D(DUZ) D ^XUP
5 S SAVEDUZ=DUZ,DUZ=.5
6 S DIR(0)="F^2:60",DIR("A")="Full path, up to but not including patch names" D ^DIR G:Y="^" EXIT S ROOT=Y
7 K FILE S ARRAY("*")=""
8 S Y=$$LIST^%ZISH(ROOT,"ARRAY","FILE") I 'Y W !,"Error getting directory list" G EXIT
9 K ERROR S PATCH="" F S PATCH=$O(FILE(PATCH)) Q:PATCH="" D Q:$D(ERROR)
10 . K ^TMP($J)
11 . ; Gather the message
12 . S Y=$$FTG^%ZISH(ROOT,PATCH,$NA(^TMP($J,1,0)),2) I 'Y W !,"Error copying to global" S ERROR=1 Q
13 . S XMSUBJ=PATCH
14 . S ^TMP($J,1,0)="$TXT "_^TMP($J,1,0)
15 . S ^TMP($J,3,0)="$END TXT"
16 . S ^TMP($J,4,0)="$KID "_^TMP($J,6,0)
17 . S Y=$O(^TMP($J,""),-1) K ^TMP($J,Y)
18 . S ^TMP($J,Y-1,0)="$END KID "_^TMP($J,6,0)
19 . ; Deliver the message
20 . D SENDMSG^XMXAPI(.5,XMSUBJ,$NA(^TMP($J)),SAVEDUZ,,.XMZ)
21 . I $D(XMERR) W !,"MailMan error, see ^TMP(""XMERR"",$J)" S ERROR=1 Q
22 . ; Set MESSAGE TYPE to KIDS build
23 . S $P(^XMB(3.9,XMZ,0),"^",7)="K"
24 W !,"Done"
25EXIT S DUZ=SAVEDUZ K ROOT,DIC,Y,DIR,FILE,XMSUBJ,PATCH,^TMP($J),ERROR,SAVEDUZ,XMZ
26 Q
Note: See TracBrowser for help on using the repository browser.