A1B2T2 ;ALB/EG EXTRACT FROM ODS FILES AND PUT IN MESSAGE 2 ; JAN 12 1991
;;Version 1.55 (local for MAS v5 sites);;
K ^UTILITY("TRN1",$J) S KNT=2,K4=2,KNT1="",A1B2T2=1,A1B2FLAG=0
F AI=1:1 S KNT1=$O(^UTILITY("TRN",$J,2,A1B2T2,KNT1)) Q:KNT1="" S K3=$O(^UTILITY("TRN",$J,2,A1B2T2,KNT1,0)) I $D(^UTILITY("TRN",$J,2,A1B2T2,KNT1)) D PSET S KNT=KNT+1
S KNT1="" F A1B2T2=2:1:8 F AI=1:1 S KNT1=$O(^UTILITY("TRN",$J,2,A1B2T2,KNT1)) Q:KNT1="" I $D(^UTILITY("TRN",$J,2,A1B2T2,KNT1,0)) S ^UTILITY("TRN1",$J,2,KNT,0)=^UTILITY("TRN",$J,2,A1B2T2,KNT1,0),KNT=KNT+1
I KNT>3 S ^UTILITY("TRN1",$J,2,KNT,0)="$END" D MSG1
S K4=3,KNT=2,KNT1="",A1B2T2=1 F AI=1:1 S KNT1=$O(^UTILITY("TRN",$J,3,A1B2T2,KNT1)) Q:KNT1="" S K3=$O(^UTILITY("TRN",$J,3,A1B2T2,KNT1,0)) I $D(^UTILITY("TRN",$J,3,A1B2T2,KNT1)) D PSET S KNT=KNT+1
S KNT1="" F A1B2T2=2:1:8 F AI=1:1 S KNT1=$O(^UTILITY("TRN",$J,3,A1B2T2,KNT1)) Q:KNT1="" I $D(^UTILITY("TRN",$J,3,A1B2T2,KNT1,0)) S ^UTILITY("TRN1",$J,3,KNT,0)=^UTILITY("TRN",$J,3,A1B2T2,KNT1,0),KNT=KNT+1
I KNT>3 S ^UTILITY("TRN1",$J,3,KNT,0)="$END" D MSG2
END K ^UTILITY("TRN1",$J),A1B2DEST,A1B2FLAG,A1B2FN,A1B2MG,A1B2NET,A1B2NOW,A1B2T2,AI,AI1,AK,DGTOUT,K3,K4,KNT,KNT1,XMSUB,XMTEXT,XMY,XMZ
Q
PSET S ^UTILITY("TRN1",$J,K4,KNT,0)=^UTILITY("TRN",$J,K4,A1B2T2,KNT1,K3,0)
Q:KNT1=.5 S ^UTILITY("TRN1",$J,K4,KNT+1,0)=^UTILITY("TRN",$J,K4,A1B2T2,KNT1,K3+.5,0)
S KNT=KNT+1
Q
MSG1 ;new ods message (2)
D ET S ^UTILITY("TRN1",$J,2,1,0)="$START"_U_2_U_KNT_U_A1B2NET_U_DGTOUT,XMSUB="ODS NEW from "_A1B2NET,XMTEXT="^UTILITY(""TRN1"","_$J_",2,"
S XMY("G.ODS-SERVER@"_A1B2DEST)="" D SRV,^XMD K XMSUB,XMTEXT,XMY S A1B2FLAG=A1B2FLAG+1
S A1B2TR=2 F FL=11500.1,11500.2,11500.3,11500.4,11500.61,11500.62,11500.63,11500.64 S A1B2DA="" F AI=1:1 S A1B2DA=$O(^UTILITY("TRN2",$J,A1B2TR,FL,A1B2DA)) Q:A1B2DA="" D SENT
K ^UTILITY("TRN2",$J,A1B2TR),A1B2DA,AI,A1B2TR,AI,FL
Q
MSG2 ;correction ods message (3)
D ET S ^UTILITY("TRN1",$J,3,1,0)="$START"_U_3_U_KNT_U_A1B2NET_U_DGTOUT,XMSUB="ODS CORRECTION from "_A1B2NET,XMTEXT="^UTILITY(""TRN1"","_$J_",3,"
S XMY("G.ODS-SERVER@"_A1B2DEST)="" D SRV,^XMD K XMSUB,XMTEXT,XMY S A1B2FLAG=A1B2FLAG+10
S A1B2TR=3 F FL=11500.1,11500.2,11500.3,11500.4,11500.61,11500.62,11500.63,11500.64 S A1B2DA="" F AI=1:1 S A1B2DA=$O(^UTILITY("TRN2",$J,A1B2TR,FL,A1B2DA)) Q:A1B2DA="" D SENT
K ^UTILITY("TRN2",$J,A1B2TR),A1B2DA,AI,A1B2TR,AI,FL
Q
SENT ;set transmission flag
S DIE=FL,DA=A1B2DA,DR="1.01///1;1.06////"_XMZ D ^DIE K DA,DIE,DR
Q
NADA S %DT="ST",X="NOW" D ^%DT S A1B2NOW=Y,AJ=$S(A1B2FLAG=1:1,A1B2FLAG>9:2,1:9),A1B2FLAG=AJ
S DIE=11500.5,DA=1,DLAYGO=11500.5,DR=".04////"_A1B2NOW_";.05///"_A1B2FLAG D ^DIE K DA,DIE,DR
K AJ S AJ=$S(A1B2FLAG=1:2,A1B2FLAG=9:1,A1B2FLAG=2:3,1:1),A1B2FLAG=AJ,XMSUB="ODS STATUS from "_A1B2NET
S AJ(1,0)="$START^9^1^"_A1B2NET_U_A1B2FN_U_A1B2FLAG,AJ(2,0)="$NADA^NO DATA TO TRANSMIT",XMTEXT="AJ(" D SRV,^XMD K %DT,AJ,XMSUB,XMTEXT,XMY
Q
SRV ;address
S AK=0,AJ="ODS CONFIRMATION",XMY("S.A1B2Z-SERVER@"_A1B2DEST)="",A1B2MG=$S('$D(^XMB(3.8,"B",AJ)):.5,1:$O(^XMB(3.8,"B",AJ,0)))
I A1B2MG'=.5 F AI1=1:1 S AK=$O(^XMB(3.8,A1B2MG,1,AK)) Q:(AK="")!(AK'?.N) S XMY(^XMB(3.8,A1B2MG,1,AK,0))=""
Q
ET ;elapsed time for run
Q:$D(H1)=0 S H2=$H D ET1 Q
;
ET1 ;H1-start time,H2-end time,DGTOUT-difference in seconds
S H1(1)=$P(H1,",",1),H1(2)=$P(H1,",",2),H2(1)=$P(H2,",",1),H2(2)=$P(H2,",",2)
I H1(1)=H2(1) S DGTOUT=H2(2)-H1(2) Q
S DGTOUT=86400*(H2(1)-H1(1))+(H2(2)-H1(2)) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HA1B2T2 3467 printed Nov 22, 2024@17:31:32 Page 2
A1B2T2 ;ALB/EG EXTRACT FROM ODS FILES AND PUT IN MESSAGE 2 ; JAN 12 1991
+1 ;;Version 1.55 (local for MAS v5 sites);;
+2 KILL ^UTILITY("TRN1",$JOB)
SET KNT=2
SET K4=2
SET KNT1=""
SET A1B2T2=1
SET A1B2FLAG=0
+3 FOR AI=1:1
SET KNT1=$ORDER(^UTILITY("TRN",$JOB,2,A1B2T2,KNT1))
if KNT1=""
QUIT
SET K3=$ORDER(^UTILITY("TRN",$JOB,2,A1B2T2,KNT1,0))
IF $DATA(^UTILITY("TRN",$JOB,2,A1B2T2,KNT1))
DO PSET
SET KNT=KNT+1
+4 SET KNT1=""
FOR A1B2T2=2:1:8
FOR AI=1:1
SET KNT1=$ORDER(^UTILITY("TRN",$JOB,2,A1B2T2,KNT1))
if KNT1=""
QUIT
IF $DATA(^UTILITY("TRN",$JOB,2,A1B2T2,KNT1,0))
SET ^UTILITY("TRN1",$JOB,2,KNT,0)=^UTILITY("TRN",$JOB,2,A1B2T2,KNT1,0)
SET KNT=KNT+1
+5 IF KNT>3
SET ^UTILITY("TRN1",$JOB,2,KNT,0)="$END"
DO MSG1
+6 SET K4=3
SET KNT=2
SET KNT1=""
SET A1B2T2=1
FOR AI=1:1
SET KNT1=$ORDER(^UTILITY("TRN",$JOB,3,A1B2T2,KNT1))
if KNT1=""
QUIT
SET K3=$ORDER(^UTILITY("TRN",$JOB,3,A1B2T2,KNT1,0))
IF $DATA(^UTILITY("TRN",$JOB,3,A1B2T2,KNT1))
DO PSET
SET KNT=KNT+1
+7 SET KNT1=""
FOR A1B2T2=2:1:8
FOR AI=1:1
SET KNT1=$ORDER(^UTILITY("TRN",$JOB,3,A1B2T2,KNT1))
if KNT1=""
QUIT
IF $DATA(^UTILITY("TRN",$JOB,3,A1B2T2,KNT1,0))
SET ^UTILITY("TRN1",$JOB,3,KNT,0)=^UTILITY("TRN",$JOB,3,A1B2T2,KNT1,0)
SET KNT=KNT+1
+8 IF KNT>3
SET ^UTILITY("TRN1",$JOB,3,KNT,0)="$END"
DO MSG2
END KILL ^UTILITY("TRN1",$JOB),A1B2DEST,A1B2FLAG,A1B2FN,A1B2MG,A1B2NET,A1B2NOW,A1B2T2,AI,AI1,AK,DGTOUT,K3,K4,KNT,KNT1,XMSUB,XMTEXT,XMY,XMZ
+1 QUIT
PSET SET ^UTILITY("TRN1",$JOB,K4,KNT,0)=^UTILITY("TRN",$JOB,K4,A1B2T2,KNT1,K3,0)
+1 if KNT1=.5
QUIT
SET ^UTILITY("TRN1",$JOB,K4,KNT+1,0)=^UTILITY("TRN",$JOB,K4,A1B2T2,KNT1,K3+.5,0)
+2 SET KNT=KNT+1
+3 QUIT
MSG1 ;new ods message (2)
+1 DO ET
SET ^UTILITY("TRN1",$JOB,2,1,0)="$START"_U_2_U_KNT_U_A1B2NET_U_DGTOUT
SET XMSUB="ODS NEW from "_A1B2NET
SET XMTEXT="^UTILITY(""TRN1"","_$JOB_",2,"
+2 SET XMY("G.ODS-SERVER@"_A1B2DEST)=""
DO SRV
DO ^XMD
KILL XMSUB,XMTEXT,XMY
SET A1B2FLAG=A1B2FLAG+1
+3 SET A1B2TR=2
FOR FL=11500.1,11500.2,11500.3,11500.4,11500.61,11500.62,11500.63,11500.64
SET A1B2DA=""
FOR AI=1:1
SET A1B2DA=$ORDER(^UTILITY("TRN2",$JOB,A1B2TR,FL,A1B2DA))
if A1B2DA=""
QUIT
DO SENT
+4 KILL ^UTILITY("TRN2",$JOB,A1B2TR),A1B2DA,AI,A1B2TR,AI,FL
+5 QUIT
MSG2 ;correction ods message (3)
+1 DO ET
SET ^UTILITY("TRN1",$JOB,3,1,0)="$START"_U_3_U_KNT_U_A1B2NET_U_DGTOUT
SET XMSUB="ODS CORRECTION from "_A1B2NET
SET XMTEXT="^UTILITY(""TRN1"","_$JOB_",3,"
+2 SET XMY("G.ODS-SERVER@"_A1B2DEST)=""
DO SRV
DO ^XMD
KILL XMSUB,XMTEXT,XMY
SET A1B2FLAG=A1B2FLAG+10
+3 SET A1B2TR=3
FOR FL=11500.1,11500.2,11500.3,11500.4,11500.61,11500.62,11500.63,11500.64
SET A1B2DA=""
FOR AI=1:1
SET A1B2DA=$ORDER(^UTILITY("TRN2",$JOB,A1B2TR,FL,A1B2DA))
if A1B2DA=""
QUIT
DO SENT
+4 KILL ^UTILITY("TRN2",$JOB,A1B2TR),A1B2DA,AI,A1B2TR,AI,FL
+5 QUIT
SENT ;set transmission flag
+1 SET DIE=FL
SET DA=A1B2DA
SET DR="1.01///1;1.06////"_XMZ
DO ^DIE
KILL DA,DIE,DR
+2 QUIT
NADA SET %DT="ST"
SET X="NOW"
DO ^%DT
SET A1B2NOW=Y
SET AJ=$SELECT(A1B2FLAG=1:1,A1B2FLAG>9:2,1:9)
SET A1B2FLAG=AJ
+1 SET DIE=11500.5
SET DA=1
SET DLAYGO=11500.5
SET DR=".04////"_A1B2NOW_";.05///"_A1B2FLAG
DO ^DIE
KILL DA,DIE,DR
+2 KILL AJ
SET AJ=$SELECT(A1B2FLAG=1:2,A1B2FLAG=9:1,A1B2FLAG=2:3,1:1)
SET A1B2FLAG=AJ
SET XMSUB="ODS STATUS from "_A1B2NET
+3 SET AJ(1,0)="$START^9^1^"_A1B2NET_U_A1B2FN_U_A1B2FLAG
SET AJ(2,0)="$NADA^NO DATA TO TRANSMIT"
SET XMTEXT="AJ("
DO SRV
DO ^XMD
KILL %DT,AJ,XMSUB,XMTEXT,XMY
+4 QUIT
SRV ;address
+1 SET AK=0
SET AJ="ODS CONFIRMATION"
SET XMY("S.A1B2Z-SERVER@"_A1B2DEST)=""
SET A1B2MG=$SELECT('$DATA(^XMB(3.8,"B",AJ)):.5,1:$ORDER(^XMB(3.8,"B",AJ,0)))
+2 IF A1B2MG'=.5
FOR AI1=1:1
SET AK=$ORDER(^XMB(3.8,A1B2MG,1,AK))
if (AK="")!(AK'?.N)
QUIT
SET XMY(^XMB(3.8,A1B2MG,1,AK,0))=""
+3 QUIT
ET ;elapsed time for run
+1 if $DATA(H1)=0
QUIT
SET H2=$HOROLOG
DO ET1
QUIT
+2 ;
ET1 ;H1-start time,H2-end time,DGTOUT-difference in seconds
+1 SET H1(1)=$PIECE(H1,",",1)
SET H1(2)=$PIECE(H1,",",2)
SET H2(1)=$PIECE(H2,",",1)
SET H2(2)=$PIECE(H2,",",2)
+2 IF H1(1)=H2(1)
SET DGTOUT=H2(2)-H1(2)
QUIT
+3 SET DGTOUT=86400*(H2(1)-H1(1))+(H2(2)-H1(2))
QUIT
