rutinas MUMPS servicio socket para saber existencias reales

ZVZLEEPORT

ZVZLEEPORT	;
INI	;
	; prueba lectura puerto
 	; lanza rutina ZVZLEEPORT3
	; que es la que tratará lo leido
	;
 	S S="#"
 	S $ZT="TRAP"
 	; solo lo ejecutamos en el shadow
	I '$D(^["%SYS"]ZDISFAR("SHADOW")) Q
	; 
 	S PORT=4444  ;  puerto de comunicacion
 	S IP="" ; para el servidor no se define IP
 	S DEV="|TCP|"_PORT ; dispositivo
 	S MAXCONEX=12   ; maximo numero de conexiones clientes
 	S TIMEOUTOPEN=10
OPEN ;
 	O DEV:(IP:PORT:"MA/CON="_MAXCONEX):TIMEOUTOPEN
 	I '$T Q
 	U DEV
ACEPTA ;
	R ACEPTA:5 
 	I $T J ^ZVZLEEPORT3:(:5:DEV:DEV) ; servidor TCP hijo
 	G ACEPTA
 	;
TRAP ;
 	D ^%ZPETIME
 	S ^EZVZKERR(^PZP(2,0),%TIM,"ZVZLEEPORT")=$ZE_S_"acepta:"_$G(ACEPTA)
 	Q
FIN	;
	C DEV
	Q

ZVZLEEPORT3

ZVZLEEPORT3	;
	; prueba concepto recogida
	; peticion servicio consulta existencias reales
	; viene de ZVZLEEPORT
	; en cuanto recibe el final de la peticion socket (o HTTP) ejecuta funcion $$EXREALES
	; NO DEVUELVE RESPUESTA HTTP
	; 
	; 
	S ZVZPARAM=$G(^ZVZLEEPORT3("param"))
	; puerto conlog limpiahex cliescasez
	S DATOS="",ERROR="",LOOPS=0,TIMEOUT=5
	S CONHEX=1
	S CONLOG=$P(ZVZPARAM,"#",2) I CONLOG="" S CONLOG=1
	S CONHEX=$P(ZVZPARAM,"#",3) I CONHEX="" S CONHEX=1
	;
LEE	;
	R *ZB:1
 	I ZB=-1 D  Q:ERROR'=""  G LEE
 	. S LOOPS=LOOPS+1
 	. I LOOPS>TIMEOUT S ERROR="TIMEOUT" D ERROR
 	;
	I 0 I ZB>127 S ZB=ZB-128
	S CHAR=$C(ZB)
	S DATOS=DATOS_CHAR
	;
	; traducimos si nos llega algun caracter hexadecimal
	I CONHEX=1 I $F(DATOS,"%") D LIMPIAHEX
	; por fin pedido fedicom
	I $F(DATOS,"0199"_$C(13)) D GRABA Q
	; por fin mensaje get o post
	S FINPOST=$C(13)_$C(10)_$C(13)_$C(10)
	I $E(DATOS,$L(DATOS)-3,$L(DATOS))=FINPOST D GRABA Q
	;
	;I $F(DATOS,$C(13)) D GRABA Q
	;I $F(DATOS,"HTTP/") D GRABA Q
	; por longitud en un post
	;I $F(DATOS,"Content-Length: ") S ESCUCHA=+$P(L,"Content-Length: ",2)
	; &
	G LEE
	;
GRABA	;
	; devolvemos resultado peticion
	; 
	I $F(DATOS,"/favicon.ico HTTP") Q
	;
	; log input
	I CONLOG=1 D
	. D HORA
	. S NE=$O(^ZVZLEEPORT3("log",^PZP(2,0),HORA,""),-1)+1
 	. S ^ZVZLEEPORT3("log",^PZP(2,0),HORA,NE,"in")=DATOS
 	;
	; es peticion HTTP
	S DATOS=$P(DATOS," HTTP/",1) ; fijase en el espacio previo
	S DATOS=$P(DATOS,FINPOST,1)
	S VALOR404="404 algo has escrito mal..."
	S VALOR=VALOR404
	;
	; funciones varias
	I $F(DATOS,"ExistenciasReales?q=") D
	. S ARTICULOS=$P(DATOS,"=",2)
	. S VALOR=$$EXREALES^ZVZLEEPORT3(ARTICULOS) 
	;
	I $F(DATOS,"ExistenciasReales#") D
	. S ARTICULOS=$P(DATOS,"#",2)
	. S VALOR=$$EXREALES^ZVZLEEPORT3(ARTICULOS) 
	;
	; Zcfrv tiene otras funciones especiales
	I $P(^PARAM("G","G",1),"#",22)="VZ" D ZCFRV
	;
	; respuesta
	W VALOR
	;
	; log output
	I CONLOG=1 D
	. ;I VALOR'=VALOR404 Q
	. S NE=$O(^ZVZLEEPORT3("log",^PZP(2,0),HORA,""),-1)+1
 	. S ^ZVZLEEPORT3("log",^PZP(2,0),HORA,NE,"out")=VALOR ;;_";;;"_DATOS
	Q
	;
 	;
EXREALES(ARTS)	;
	N (ARTS)
	; devolvemos existencias reales
	; van separados por |
	; 
	S SP="|"
	S S="#"
	S CLIESCASEZ=$P($G(^ZVZLEEPORT3("param")),S,4)
	S ALM=$P(^PARAM("G","G",1),S)
	S DEVUELVE=""
	I $G(ARTS)="" Q DEVUELVE
	;
	F I=1:1:$L(ARTS,"|") S AR=$P(ARTS,SP,I) D
	. S EX="" S SIPUEDE=1
	. I AR'="" S EX=$$CTEXIST^FUT005A0(AR,ALM)
	. I CLIESCASEZ'="" D LIMITADOS
	. I SIPUEDE=0 S EX=0
	. S DEVUELVE=DEVUELVE_$S(I=1:EX,1:SP_EX)
	;
	Q DEVUELVE
	;
	;
LIMITADOS	;
	; devolvemos existencias según limitaciones
	; del cliente tipo
	;
	; control MSE
	I $D(^MSE(CLIESCASEZ,AR)) S MAX=$P(^MSE(CLIESCASEZ,AR),S,1)-$P(^MSE(CLIESCASEZ,AR),S,2) I EX>MAX S EX=MAX
	; control CAP
	I $D(^CAP(CLIESCASEZ,AR)) S SIPUEDE=0
	; control claves control pedido por tipo pedido
	S CLCONTROL=$P($G(^ART(AR)),S,20) S CLN="-"_CLCONTROL
	S TPDEF=$P($G(^VAR(CLIESCASEZ)),S,2)
	I CLCONTROL'="" D
	. I TPDEF'="" S NOPER=$P($G(^TAG("TPE",TPDEF)),S,40) F NN=1:1:$L(NOPER,",") I $P(NOPER,",",NN)=CLN S SIPUEDE=0
	. ; control claves control prohibidas por cliente
	. S NOPER=$G(^CCP(CLIESCASEZ)) F NN=1:1:$L(NOPER,",") I $P(NOPER,",",NN)=CLCONTROL S SIPUEDE=0
	. ; control claves control por tipo de cliente
	. ; control laboratorios prohibido
	. ; control familias permitidas en tipo pedido $P(^TAG("TPE",2),"#",28)
	. ;
	Q
	;
	;
LIMPIAHEX	;
	S DESDE=$F(DATOS,"%")-1
	S HASTA=DESDE+2
	I $E(DATOS,DESDE,HASTA)="%5D" S $E(DATOS,DESDE,HASTA)="]"
	I $E(DATOS,DESDE,HASTA)="%5B" S $E(DATOS,DESDE,HASTA)="["
	I $E(DATOS,DESDE,HASTA)="%7B" S $E(DATOS,DESDE,HASTA)="{"
	I $E(DATOS,DESDE,HASTA)="%7C" S $E(DATOS,DESDE,HASTA)="|"
	I $E(DATOS,DESDE,HASTA)="%7D" S $E(DATOS,DESDE,HASTA)="}"
	I $E(DATOS,DESDE,HASTA)="%3A" S $E(DATOS,DESDE,HASTA)=":"
	I $E(DATOS,DESDE,HASTA)="%2C" S $E(DATOS,DESDE,HASTA)=","
	I $E(DATOS,DESDE,HASTA)="%22" S $E(DATOS,DESDE,HASTA)=""""
	I $E(DATOS,DESDE,HASTA)="%23" S $E(DATOS,DESDE,HASTA)="#"
	I $E(DATOS,DESDE,HASTA)="%27" S $E(DATOS,DESDE,HASTA)="'"
	;S $E(DATOS,DESDE+1,HASTA)=$C($ZH($E(DATOS,DESDE+1,HASTA))) ; funcion convierte hexadecimal a decimal $ZH
	Q
	;
ZCFRV	;
	; funciones propias
	; 
	I $P(DATOS,"|",1)="SOCIOS" D
	. S DATOS=$TR(DATOS," ","")
	. S VALOR=$$SOCIOFONH^ZVZeWEB2(2525,DATOS)
	;
	I $P(DATOS,"|",1)="SOCIO" D
	. S DATOS=$TR(DATOS," ","")
	. S VALOR=$$SOCIODATOSH^ZVZeWEB2($P(DATOS,"|",5),DATOS)
	;
	I $P(DATOS,"|",1)="ART" D
	. S DATOS=$TR(DATOS," ","")
	. S VALOR=$$ARTDATOSH^ZVZeWEB2(2525,DATOS)
	;
	I $P(DATOS,"|",1)="ARTS" D
	. S DATOS=$TR(DATOS," ","")
	. S VALOR=$$ARTFONH^ZVZeWEB2(2525,DATOS)
	;
	I $P(DATOS,"|",1)="GLOBALH" D
	. S VALOR=$$GLOBALH^ZVZeWEB2(2525,DATOS)
	;
	I $P(DATOS,"|",1)="GADGETH" D
	. S VALOR=$$GADGETH^ZVZeWEB2(2525,DATOS)
	;
	I $P(DATOS,"|",1)="GUARDIADEHOY" D
	. S VALOR=$$GUARDIAH^ZVZeWEB2(2525,DATOS)
	;
	I $P(DATOS,"|",1)="CUBETA" D
	. S DATOS=$TR(DATOS," ","")
	. S VALOR=$$CUBETA^ZVZeWEB2(2525,DATOS)
	;
	I $P(DATOS,"|",1)="TG" D
	. S DATOS=$TR(DATOS," ","")
	. S VALOR=$$RUTA^ZVZTELEGRAM($P(DATOS,"|",2,99))
 	;
	Q
	;
ERROR	;
	D HORA
	W ERROR_$C(13)_$C(10)_"_____tu me has enviado: "_DATOS
	F I=1:1:$L(DATOS) W $A($E(DATOS,I,I))
	S ^ZVZLEEPORT3("error",^PZP(2,0),$G(HORA,$P($H,",",2)),$P)=ERROR_S_DATOS
	Q
	;
	;
HORA	;
	S H=$P($H,",",2)
 	S H1=H\3600,X1=H#3600,M1=X1\60,S1=X1#60
	I $L(H1)<2 S H1=$E(H1+100,2,3)
 	I $L(M1)<2 S M1=$E(M1+100,2,3)
 	I $L(S1)<2 S S1=$E(S1+100,2,3)
 	S HORA=H1_":"_M1_":"_S1
 	Q