source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMPH.m@ 703

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

initial load of WorldVistAEHR

File size: 2.9 KB
Line 
1XMPH ;(WASH ISC)/THM/CAP-PackMan Load Routines/Print Msg ;12/04/2002 13:48
2 ;;8.0;MailMan;**10**;Jun 28, 2002
3 ; Entry points used by MailMan options (not covered by DBIA):
4 ; LOAD XMPROU - Load routines
5 ;USER ENTRY LIST OF ROUTINES
6 Q
7DEV ;GET OUTPUT DEVICE / QUEUE PACKMAN PRINT
8 N I,ZTSAVE
9 F I="DIE","XMZ","XMDUZ","XMV(","XMP2","XMR","XCF" S ZTSAVE(I)=""
10 D EN^XUTMDEVQ("ZTSK^XMPH","MailMan: PackMan Print",.ZTSAVE)
11 Q
12ZTSK ;QUEUED PRINT COMES HERE
13 N XMSUBJ,XMZSTR
14 I XCF=3 D
15 . D TOP^XMPC
16 E I $E($G(IOST),1,2)'="C-" D
17 . N XMPARM,XMZREC
18 . S XMZREC=$G(^XMB(3.9,XMZ,0))
19 . W $$EZBLD^DIALOG($S($P(XMZREC,U,7)["K":34076,1:34077)) ; KIDS Build / PackMan message
20 . W $S(XMP2="T":" text print for ",1:" print for "),XMV("NAME")
21 . S XMPARM(1)=^XMB("NETNAME"),XMPARM(2)=$$MMDT^XMXUTIL1($$NOW^XLFDT)
22 . W !,$$EZBLD^DIALOG(34503,.XMPARM) ; Printed at |1| |2|
23 . Q:XMP2="S"
24 . S XMSUBJ=$$EZBLD^DIALOG(34536,$$SUBJ^XMXUTIL2(XMZREC)) ; Subj: |1|
25 . S XMZSTR=$$EZBLD^DIALOG(34537,XMZ) ; [#|1|]
26 . W !,XMSUBJ
27 . D W^XMJMP1(" ",XMZSTR)
28 . D W^XMJMP1(" ",$$DATE^XMXUTIL2(XMZREC))
29 . D WL^XMJMP1($$EZBLD^DIALOG(34538,$$NAME^XMXUTIL($P(XMZREC,U,2),1))) ; From:
30 . D W^XMJMP1(" ",$$EZBLD^DIALOG(34541)) ; Page 1
31 . D LINE^XMJMP1
32 . W !
33 D S^XMP2
34 I $D(ZTQUEUED) S ZTREQ="@"
35 Q
36LOAD ;LOAD ROUTINE FROM <X> INTO GLOBAL <DIF>_I_",0)"
37 ;
38 ;DIFROM NEEDS A MESSAGE NUMBER
39 ;
40 S (DIE,DIF)="^XMB(3.9,XMZ,2,"
41 I $D(DIFROM) W !!,"Please enter the names of the routines you wish to load into this message.",!!,"Only routines will be loaded."
42 I W !!,"INITs, will be sent automatically.",!!
43 ;K ^UTILITY($J#256)
44 X ^%ZOSF("RSEL") Q:$O(^UTILITY($J,0))=""
45 S X=0 S:'$D(XCNP) XCNP=0
46 F S X=$O(^UTILITY($J,X)) Q:X="" D LL
47 K ^UTILITY($J)
48 Q
49LL N XMHOLD S XMHOLD=XCNP
50 W !,"Loading ",X S DIF=DIE,XCNP=XCNP+1,@(DIF_XCNP_",0)")="$ROU "_X
51 X ^%ZOSF("LOAD") S $P(@(DIF_"0)"),U,3,4)=XCNP_U_XCNP
52 S @(DIF_XCNP_",0)")="$END ROU "_X
53 ;
54 ;Check for control characters in text
55 F XMHOLD=XMHOLD:1:XCNP I $G(@(DIF_XMHOLD_",0)"))?.E1C.E D S XQCH="HALT" G H^XUS
56 . W !!,$C(7),"Errored out loading routine ",X," - control character in text."
57 . W !,"Use ^XINDEX to identify it, then remove from routine and try again.",!!
58 . D KILLMSG^XMXUTIL(XMZ)
59 Q
60 ;
61PACK ;LOAD ENTIRE PACKAGE (ROUTINES ONLY)
62 ;
63 S:'$D(XCNP) XCNP=0
64 I '$D(DIFROM) S DIC="^DIC(9.4,",DIC(0)="AEQM" D ^DIC Q:Y<0 S DA=+Y
65 S XMROU="^DIC(9.4,"_DA_",2,""B"","
66P S (XMA0,XMB0)="",(DIE,DIF)="^XMB(3.9,"_XMZ_",2,"
67 G P9:'$D(^%ZOSF("TEST")) S XMB=^("TEST")
68P1 S XMA0=$O(@(XMROU_"XMA0)")) I $L(XMA0) D TST G P1
69 G ER:XMB0
70P9 S XMA0=$O(@(XMROU_"XMA0)")) G Q:XMA0="" S X=XMA0 D LL G P9
71 ;
72XMROU ;LOAD ROUTINES (FROM XMD)
73 ;
74 S XCNP=XCNP+1,$P(^XMB(3.9,XMZ,2,0),U,3,4)=XCNP_U_XCNP,^(XCNP,0)="$END TXT"
75 S XMROU="XMROU(" G P
76 ;
77TST S X=XMA0 X XMB Q:$T S XMB0=1 W !,"Program ",X," does not exist." Q
78ER W !!,"<< Correct the errors listed above.",!,"Then you may try again.",!
79Q K XMA0,XMB0,XMB,XMROU,DIE,DIF Q
Note: See TracBrowser for help on using the repository browser.