A1B2T4 ;ALB/EG - XM UTILITY ;FEB 7 1991
;;Version 1.55 (local for MAS v5 sites);;
;;V1.0
;XMTEXT array must have closed form, i.e. XMTEXT="AX" or "AX(1)"
;"AX(2," is not allowed. Local or global are allowed.
;XMDUZ must be valid DUZ or POSTMASTER. Returned variables
;Y > 0:Message filed, Y < 0:Message not filed
;XMZ defined:Message delivered, XMZ not defined:No delivery.
;A1B2XMY array contains network recipients which must be resolved.
;
EN1 Q:(XMSUB="")!(XMDUZ="")!(XMTEXT="")!('$D(XMY))
S XMN=0,AJ="" F I=0:0 S AJ=$O(A1B2XMY(AJ)) Q:AJ="" S X=AJ D WHO^XMA21
K XMZ S U="^",DIC="^XMB(3.9,",DIC(0)="L",DLAYGO=3.9,X=XMSUB D FILE^DICN K DIC G:Y<0 END
EN2 S DA=$P(Y,U,1),K=0 L ^XMB(3.9,DA):1 G:'$T EN2 F I=1:1 S K=$O(@XMTEXT@(K)) Q:K="" S ^XMB(3.9,DA,2,I,0)=$S($D(@XMTEXT@(K))=10:@XMTEXT@(K,0),1:@XMTEXT@(K))
S ^XMB(3.9,DA,2,0)="^3.91^"_I_U_I
D NOW^%DTC S DIE="^XMB(3.9,",DR="1////"_XMDUZ_";1.4////"_% D ^DIE K DIE,DR,DLAYGO
S XMCHAN=1,XMDUN=$S($D(^DIC(3,XMDUZ,0)):$P(^(0),U,1),1:"POSTMASTER"),XMZ=DA K XMTEXT D ENT1^XMD
L D END
Q
END ;
K %,A1B2XMY,DA,I,K,X,XMCHAN,XMDUN,XMDUZ,XMN,XMSUB,XMTEXT,XMY
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA1B2T4 1145 printed Dec 13, 2024@02:21:30 Page 2
A1B2T4 ;ALB/EG - XM UTILITY ;FEB 7 1991
+1 ;;Version 1.55 (local for MAS v5 sites);;
+2 ;;V1.0
+3 ;XMTEXT array must have closed form, i.e. XMTEXT="AX" or "AX(1)"
+4 ;"AX(2," is not allowed. Local or global are allowed.
+5 ;XMDUZ must be valid DUZ or POSTMASTER. Returned variables
+6 ;Y > 0:Message filed, Y < 0:Message not filed
+7 ;XMZ defined:Message delivered, XMZ not defined:No delivery.
+8 ;A1B2XMY array contains network recipients which must be resolved.
+9 ;
EN1 if (XMSUB="")!(XMDUZ="")!(XMTEXT="")!('$DATA(XMY))
QUIT
+1 SET XMN=0
SET AJ=""
FOR I=0:0
SET AJ=$ORDER(A1B2XMY(AJ))
if AJ=""
QUIT
SET X=AJ
DO WHO^XMA21
+2 KILL XMZ
SET U="^"
SET DIC="^XMB(3.9,"
SET DIC(0)="L"
SET DLAYGO=3.9
SET X=XMSUB
DO FILE^DICN
KILL DIC
if Y<0
GOTO END
EN2 SET DA=$PIECE(Y,U,1)
SET K=0
LOCK ^XMB(3.9,DA):1
if '$TEST
GOTO EN2
FOR I=1:1
SET K=$ORDER(@XMTEXT@(K))
if K=""
QUIT
SET ^XMB(3.9,DA,2,I,0)=$SELECT($DATA(@XMTEXT@(K))=10:@XMTEXT@(K,0),1:@XMTEXT@(K))
+1 SET ^XMB(3.9,DA,2,0)="^3.91^"_I_U_I
+2 DO NOW^%DTC
SET DIE="^XMB(3.9,"
SET DR="1////"_XMDUZ_";1.4////"_%
DO ^DIE
KILL DIE,DR,DLAYGO
+3 SET XMCHAN=1
SET XMDUN=$SELECT($DATA(^DIC(3,XMDUZ,0)):$PIECE(^(0),U,1),1:"POSTMASTER")
SET XMZ=DA
KILL XMTEXT
DO ENT1^XMD
+4 LOCK
DO END
+5 QUIT
END ;
+1 KILL %,A1B2XMY,DA,I,K,X,XMCHAN,XMDUN,XMDUZ,XMN,XMSUB,XMTEXT,XMY
+2 QUIT
