Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: EEOEEXMT

EEOEEXMT.m

Go to the documentation of this file.
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