- 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 Feb 18, 2025@23:47:52 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