EEOEEXMT ;HISC/JWR - TRANSMIT ROUTINE (VERSION 1.0 SITES);11/28/92 12:00
;;2.0;EEO Complaint Tracking;;Apr 27, 1995
Q:'$D(^TMP("EEOXMT",$J))
D DT^DICRW S SERV=$O(^EEO(789.5,0)),SERV=^EEO(789.5,SERV,0),AEE=+SERV,SERV=$P(^DIC(4.2,$P(SERV,"^",2),0),"^")
S XMSUB=$$SITE^EEOEEXMT_" EEO SERVER MESSAGE"_" DATA"
K CLIENT,CLIENTNO S BEE=0 F S BEE=$O(^DIC(4.2,BEE)) Q:BEE'>0 I $P($G(^(BEE,0)),"^",13)=AEE S CLIENTNO=AEE,CLIENT=$P(^(0),"^") Q
I '$D(CLIENTNO) S CLIENTNO=$O(^EEO(789.5,"B",""))
K XMY S XMY("S.EEO UPLINK SERVER@"_SERV)=""
;S XMY("G.UPLINK_DATA_SERVER@"_SERV)=""
RES S XMDUZ=DUZ K ^TMP($J)
S VEE=$S(CLIENTNO=$$SITE^EEOEEXMT:AEE,1:CLIENTNO)
S ^TMP($J,1)=$$SITE^EEOEEXMT_"^DATA"_"^"_20,FEE=2
S ^TMP($J,FEE)="&&&&&",EEE=BEE,BEE="",FEE=FEE+1 F S BEE=$O(^TMP("EEOXMT",$J,BEE)) Q:BEE="" S CEE="" F S CEE=$O(^TMP("EEOXMT",$J,BEE,CEE)) Q:CEE="" S DEE="" F S DEE=$O(^TMP("EEOXMT",$J,BEE,CEE,DEE)) Q:DEE="" D
.S EEE="" F S EEE=$O(^TMP("EEOXMT",$J,BEE,CEE,DEE,EEE)) Q:EEE="" S GEE="" F S GEE=$O(^TMP("EEOXMT",$J,BEE,CEE,DEE,EEE,GEE)) Q:GEE="" S DECR=^TMP("EEOXMT",$J,BEE,CEE,DEE,EEE,GEE) D ENCRY
S XMTEXT="^TMP($J," K XMZ D:'$D(XMY("G.UPLINK_DATA_SERVER@"_$P(^DIC(4.2,$P(^XMB(1,1,0),"^",1),0),"^",1))) ^XMD Q:'$D(XMZ)
W " " H 1 W "@"_SERV
K ^TMP($J)
EXIT K ^TMP("EEOXMT",$J),XMDUZ
Q
SITE() ;
Q $P(^DIC(4,$O(^DIC(4,"D",$P(^EEO(789.5,1,0),"^"),"")),99),"^")
FLIP I AEE D @WHAT
Q
HERE I VEE=SITE S OEE=0
Q
SERVNO() Q +^EEO(789.5,$O(^EEO(789.5,0)),0)
LONG K EEOPT S EENOD=DECR,EEOL=$L(EENOD),EEOC="" F EEOC=0:50:250 S X=$E(EENOD,EEOC+1,EEOC+50) Q:X="" D EN^XUSHSHP D
.I $D(EEOPT) S EEOPT=EEOPT_X Q
.I '$D(EEOPT) S EEOPT=X Q
S ^TMP($J,FEE+1)=EEOPT K EEOPT,EEOL,EENOD,EEOC
Q
ENCRY S X1=AEE,X2=FEE
S X=DEE_"^"_BEE_"^"_CEE_"^"_EEE_"^"_GEE
D EN^XUSHSHP S ^TMP($J,FEE)=X
I $L(DECR)<50 S X=DECR,X2=FEE+1 D EN^XUSHSHP S ^TMP($J,FEE+1)=X,FEE=FEE+2 Q
I $L(DECR)'<50 S X2=FEE+1 D LONG S FEE=FEE+2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEEOEEXMT 1961 printed Dec 13, 2024@01:50:55 Page 2
EEOEEXMT ;HISC/JWR - TRANSMIT ROUTINE (VERSION 1.0 SITES);11/28/92 12:00
+1 ;;2.0;EEO Complaint Tracking;;Apr 27, 1995
+2 if '$DATA(^TMP("EEOXMT",$JOB))
QUIT
+3 DO DT^DICRW
SET SERV=$ORDER(^EEO(789.5,0))
SET SERV=^EEO(789.5,SERV,0)
SET AEE=+SERV
SET SERV=$PIECE(^DIC(4.2,$PIECE(SERV,"^",2),0),"^")
+4 SET XMSUB=$$SITE^EEOEEXMT_" EEO SERVER MESSAGE"_" DATA"
+5 KILL CLIENT,CLIENTNO
SET BEE=0
FOR
SET BEE=$ORDER(^DIC(4.2,BEE))
if BEE'>0
QUIT
IF $PIECE($GET(^(BEE,0)),"^",13)=AEE
SET CLIENTNO=AEE
SET CLIENT=$PIECE(^(0),"^")
QUIT
+6 IF '$DATA(CLIENTNO)
SET CLIENTNO=$ORDER(^EEO(789.5,"B",""))
+7 KILL XMY
SET XMY("S.EEO UPLINK SERVER@"_SERV)=""
+8 ;S XMY("G.UPLINK_DATA_SERVER@"_SERV)=""
RES SET XMDUZ=DUZ
KILL ^TMP($JOB)
+1 SET VEE=$SELECT(CLIENTNO=$$SITE^EEOEEXMT:AEE,1:CLIENTNO)
+2 SET ^TMP($JOB,1)=$$SITE^EEOEEXMT_"^DATA"_"^"_20
SET FEE=2
+3 SET ^TMP($JOB,FEE)="&&&&&"
SET EEE=BEE
SET BEE=""
SET FEE=FEE+1
FOR
SET BEE=$ORDER(^TMP("EEOXMT",$JOB,BEE))
if BEE=""
QUIT
SET CEE=""
FOR
SET CEE=$ORDER(^TMP("EEOXMT",$JOB,BEE,CEE))
if CEE=""
QUIT
SET DEE=""
FOR
SET DEE=$ORDER(^TMP("EEOXMT",$JOB,BEE,CEE,DEE))
if DEE=""
QUIT
Begin DoDot:1
+4 SET EEE=""
FOR
SET EEE=$ORDER(^TMP("EEOXMT",$JOB,BEE,CEE,DEE,EEE))
if EEE=""
QUIT
SET GEE=""
FOR
SET GEE=$ORDER(^TMP("EEOXMT",$JOB,BEE,CEE,DEE,EEE,GEE))
if GEE=""
QUIT
SET DECR=^TMP("EEOXMT",$JOB,BEE,CEE,DEE,EEE,GEE)
DO ENCRY
End DoDot:1
+5 SET XMTEXT="^TMP($J,"
KILL XMZ
if '$DATA(XMY("G.UPLINK_DATA_SERVER@"_$PIECE(^DIC(4.2,$PIECE(^XMB(1,1,0),"^",1),0),"^",1)))
DO ^XMD
if '$DATA(XMZ)
QUIT
+6 WRITE " "
HANG 1
WRITE "@"_SERV
+7 KILL ^TMP($JOB)
EXIT KILL ^TMP("EEOXMT",$JOB),XMDUZ
+1 QUIT
SITE() ;
+1 QUIT $PIECE(^DIC(4,$ORDER(^DIC(4,"D",$PIECE(^EEO(789.5,1,0),"^"),"")),99),"^")
FLIP IF AEE
DO @WHAT
+1 QUIT
HERE IF VEE=SITE
SET OEE=0
+1 QUIT
SERVNO() QUIT +^EEO(789.5,$ORDER(^EEO(789.5,0)),0)
LONG KILL EEOPT
SET EENOD=DECR
SET EEOL=$LENGTH(EENOD)
SET EEOC=""
FOR EEOC=0:50:250
SET X=$EXTRACT(EENOD,EEOC+1,EEOC+50)
if X=""
QUIT
DO EN^XUSHSHP
Begin DoDot:1
+1 IF $DATA(EEOPT)
SET EEOPT=EEOPT_X
QUIT
+2 IF '$DATA(EEOPT)
SET EEOPT=X
QUIT
End DoDot:1
+3 SET ^TMP($JOB,FEE+1)=EEOPT
KILL EEOPT,EEOL,EENOD,EEOC
+4 QUIT
ENCRY SET X1=AEE
SET X2=FEE
+1 SET X=DEE_"^"_BEE_"^"_CEE_"^"_EEE_"^"_GEE
+2 DO EN^XUSHSHP
SET ^TMP($JOB,FEE)=X
+3 IF $LENGTH(DECR)<50
SET X=DECR
SET X2=FEE+1
DO EN^XUSHSHP
SET ^TMP($JOB,FEE+1)=X
SET FEE=FEE+2
QUIT
+4 IF $LENGTH(DECR)'<50
SET X2=FEE+1
DO LONG
SET FEE=FEE+2
+5 QUIT