- EEOEXMT2 ;HISC/JWR - TRANSMIT ROUTINE, CREATES SERVER MESSAGE (VERSION 2.0);11/28/92 12:00
- ;;2.0;EEO Complaint Tracking;**1**;Apr 27, 1995
- I '$D(^TMP("EEOXMT",$J)) D EXIT Q
- 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)=""
- RES ;Takes the transmit global ^TMP($J, and breaks it down for encryption
- 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("S.EEO UPLINK 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 ;Kills variables/arrays
- K ^TMP("EEOXMT",$J),XMDUZ,EEO,EEON0,EEON5,EEOS,EFLG,LABEL,NO,NOD,PFILE,PIECE,EEON1,EEON2,EEON3,EEON6,EEON12
- Q
- SITE() ;Determination of site number is made here
- Q $P(^DIC(4,$O(^DIC(4,"D",$P(^EEO(789.5,1,0),"^"),"")),99),"^")
- SERVNO() ;Determination of message destination
- Q +^EEO(789.5,$O(^EEO(789.5,0)),0)
- LONG ;Breaks strings too long to encrypt into smaller strings, and encrpts
- 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 ;General encryption entry point
- S X1=$$SITE^EEOEEXMT,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[HEEOEXMT2 2280 printed Mar 13, 2025@20:55:52 Page 2
- EEOEXMT2 ;HISC/JWR - TRANSMIT ROUTINE, CREATES SERVER MESSAGE (VERSION 2.0);11/28/92 12:00
- +1 ;;2.0;EEO Complaint Tracking;**1**;Apr 27, 1995
- +2 IF '$DATA(^TMP("EEOXMT",$JOB))
- DO EXIT
- 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
- +8 SET XMY("S.EEO UPLINK SERVER@"_SERV)=""
- RES ;Takes the transmit global ^TMP($J, and breaks it down for encryption
- +1 SET XMDUZ=DUZ
- KILL ^TMP($JOB)
- +2 SET VEE=$SELECT(CLIENTNO=$$SITE^EEOEEXMT:AEE,1:CLIENTNO)
- +3 SET ^TMP($JOB,1)=$$SITE^EEOEEXMT_"^DATA"_"^"_20
- SET FEE=2
- +4 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
- +5 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
- +6 SET XMTEXT="^TMP($J,"
- KILL XMZ
- if '$DATA(XMY("S.EEO UPLINK SERVER@"_$PIECE(^DIC(4.2,$PIECE(^XMB(1,1,0),"^",1),0),"^",1)))
- DO ^XMD
- if '$DATA(XMZ)
- QUIT
- +7 ;W " " H 1 W "@"_SERV
- +8 KILL ^TMP($JOB)
- EXIT ;Kills variables/arrays
- +1 KILL ^TMP("EEOXMT",$JOB),XMDUZ,EEO,EEON0,EEON5,EEOS,EFLG,LABEL,NO,NOD,PFILE,PIECE,EEON1,EEON2,EEON3,EEON6,EEON12
- +2 QUIT
- SITE() ;Determination of site number is made here
- +1 QUIT $PIECE(^DIC(4,$ORDER(^DIC(4,"D",$PIECE(^EEO(789.5,1,0),"^"),"")),99),"^")
- SERVNO() ;Determination of message destination
- +1 QUIT +^EEO(789.5,$ORDER(^EEO(789.5,0)),0)
- LONG ;Breaks strings too long to encrypt into smaller strings, and encrpts
- +1 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
- +2 IF $DATA(EEOPT)
- SET EEOPT=EEOPT_X
- QUIT
- +3 IF '$DATA(EEOPT)
- SET EEOPT=X
- QUIT
- End DoDot:1
- +4 SET ^TMP($JOB,FEE+1)=EEOPT
- KILL EEOPT,EEOL,EENOD,EEOC
- +5 QUIT
- ENCRY ;General encryption entry point
- +1 SET X1=$$SITE^EEOEEXMT
- SET X2=FEE
- +2 SET X=DEE_"^"_BEE_"^"_CEE_"^"_EEE_"^"_GEE
- +3 DO EN^XUSHSHP
- SET ^TMP($JOB,FEE)=X
- +4 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
- +5 IF $LENGTH(DECR)'<50
- SET X2=FEE+1
- DO LONG
- SET FEE=FEE+2
- +6 QUIT
