| 1 | XMPH ;(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
|
|---|
| 7 | DEV ;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
|
|---|
| 12 | ZTSK ;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
|
|---|
| 36 | LOAD ;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
|
|---|
| 49 | LL 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 | ;
|
|---|
| 61 | PACK ;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"","
|
|---|
| 66 | P S (XMA0,XMB0)="",(DIE,DIF)="^XMB(3.9,"_XMZ_",2,"
|
|---|
| 67 | G P9:'$D(^%ZOSF("TEST")) S XMB=^("TEST")
|
|---|
| 68 | P1 S XMA0=$O(@(XMROU_"XMA0)")) I $L(XMA0) D TST G P1
|
|---|
| 69 | G ER:XMB0
|
|---|
| 70 | P9 S XMA0=$O(@(XMROU_"XMA0)")) G Q:XMA0="" S X=XMA0 D LL G P9
|
|---|
| 71 | ;
|
|---|
| 72 | XMROU ;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 | ;
|
|---|
| 77 | TST S X=XMA0 X XMB Q:$T S XMB0=1 W !,"Program ",X," does not exist." Q
|
|---|
| 78 | ER W !!,"<< Correct the errors listed above.",!,"Then you may try again.",!
|
|---|
| 79 | Q K XMA0,XMB0,XMB,XMROU,DIE,DIF Q
|
|---|
