APP Mediutil
	TYPE $1000
	PATH "\APP"
	ICON "\ICN\ICONE2.pic"
ENDA

PROC Main:
	GLOBAL min$(25),maj$(7),a%(6),psion%,maj%
	GLOBAL a$(1),k%
	GLOBAL pid%,ext%
	Debut:
	IF Init%:
		DO
			Clav:
		UNTIL 0
	ENDIF
ENDP

PROC Debut:
	STATUSWIN ON
	FONT 1,1
	gBORDER 1
	gTMODE 2
	TRAP gCLOSE 2
	gCREATE(20,30,380,50,1,1)
	gXBORDER 1,3
	gUSE 2
	gORDER 2,1
	gFONT 8
	gSTYLE 9
	gAT 20,40
	gPRINT "MEDIUTIL                     "
	gAT 23,42
	gGREY 1
	gPRINT "MEDIUTIL"
	gAT 180,40
	gFONT 6
	gSTYLE 0
	gGREY 0
	gPRINT "G‚rard DELAFOND ¸ 1997"
	gUSE 1
	TRAP gCLOSE 3
	gCREATE(0,130,416,30,1,1)
	gBORDER 1
	gUSE 3
	gORDER 3,1
	gAT 20,20
	gPRINT "APPUYEZ SUR MENU, AIDE OU UN RACCOURCI CLAVIER"
ENDP

PROC Init%:
	min$="abcdefghijklmnopqrstuvw"
	maj$="AcHLV"
	RETURN 1
ENDP

PROC Clav:
	LOCAL g%,fin%
	DO
		IF ext%=1
			CALL($998d,0,pid%)
		ENDIF
		g%=Getk%:
		IF g%=290
			LOCK ON
			fin%=@(Menu$:):
			LOCK OFF
		ELSEIF (g% AND $200)
			LOCK ON
			fin%=@(Rcv$:(g%-$200)):
			LOCK OFF
		ELSEIF g%=291
			Aide:
		ELSEIF (g% AND $200)
			TRAP gCLOSE 2
			TRAP gUSE 3
			gCLS
			TRAP gCLOSE 3
			CLS
			LOCK ON
			fin%=@(Rcv$:(g%-$200)):
			LOCK OFF
		ENDIF
	UNTIL fin%
ENDP

PROC Rcv$:(g%)
	IF maj% 
		IF LOC(maj$,CHR$(g%))
			ext%=1
			RETURN "pr"+CHR$(g%)
		ELSE
			RETURN "debut"
		ENDIF
	ELSEIF LOC(min$,CHR$(g%))
		STATUSWIN OFF
		FONT 11,16
		gUSE 1
		TRAP gCLOSE 2
		TRAP gCLOSE 3
		SCREEN 46,8
		gBORDER 3
		RETURN "p"+CHR$(g%)
	ELSE
		RETURN "debut"
	ENDIF
ENDP

PROC Menu$:
	LOCAL m%
	mINIT
	mCARD "BIOLOGIE","Clearance",%c,"N.F.S.",%n,"Friedwald",%f,"Calc‚mie",%j,"Iono",%v
	mCARD "SCORES","Glasgow",%w,"Apgar",%a,"H.A.R.D.",%h,"Malinas",%l,"M.M.S.",%s,"Br–lure",%u
	mCARD "CHRONO","FR‚QUENCES",%k,"RUFFIER-DICKSON",%r
	mCARD "DIVERS","Grossesse",%g,"Masse & surface",%m,"Croissance b‚b‚",%b,"Croissance enfant",%e,"Peak flow",%p,"Dose/prise",%d,"Alcool",%o,"Test auditif",%t
	mCARD "Programmes ext","Aideordo",%A,"Aidelabo",%L,"Honoraires",%H,"Calories",%C,"Vaccins",%V
	mCARD "OPTIONS","QUITTER",%q,"INFO",%i
	m%=MENU
	TRAP gCLOSE 2
	TRAP gCLOSE 3
	CLS
	IF (m%>=%a AND m%<=%z) AND LOC(min$,CHR$(m%))
		STATUSWIN OFF
		FONT 11,16
		SCREEN 46,8
		gCLS
		gBORDER 3
		RETURN "p"+CHR$(m%)
	ELSEIF (m%>=%A AND m%<=%Z) AND LOC(maj$,CHR$(m%))
		ext%=1
		RETURN "pr"+CHR$(m%)
	ELSE
		RETURN "DEBUT"
	ENDIF
ENDP

PROC Plays:(son$,duree%)
	LOCAL n$(128),p%,ret%
	n$=son$+CHR$(0)
	ret%=CALL($1f86,UADD(ADDR(n$),1),duree%,0)
ENDP
PROC Pq:
	TRAP gCLOSE 2
	TRAP gCLOSE 3
	CLS
	AT 5,5
	PRINT "Bye !"
	PAUSE 15
	STOP
ENDP

PROC Getk%:
	LOCAL t$(1),a%(6),w$(130)
	DO
		GETEVENT a%()
		maj%=(a%(2) AND $00ff) AND 2
		psion%=(a%(2) AND $00ff) AND 8
		IF a%(1)=$404
			w$=GETCMD$
			t$=LEFT$(w$,1)
			w$=MID$(w$,2,128)
			IF t$="X"
				IF pid%<>0
					Appkill:
				ENDIF
				STOP
			ENDIF
		ENDIF
	UNTIL NOT(a%(1) AND $400)
	RETURN a%(1)
ENDP

PROC Prl: REM labo
	LOCAL pgname$(40),disc$(2)
	LOCAL cmdl$(128),ret%
	IF EXIST ("\APP\MEDIUTIL\AIDELABO.DBF")
		disc$=""
	ELSEIF EXIST ("A:\APP\MEDIUTIL\AIDELABO.DBF")
		disc$="A:"
	ELSEIF EXIST ("B:\APP\MEDIUTIL\AIDELABO.DBF")
		disc$="B:"
	ELSE
		ALERT ("AIDELABO NON INSTALL�","\APP\MEDIUTIL\AIDELABO.DBF EST N�CESSAIRE","CONTINUER")
		ext%=0
		RETURN Debut:
	ENDIF
	pgname$="ROM::data.app"+CHR$(0)
	cmdl$="Odata"+CHR$(0)+".dbf"+" "+CHR$(0)+disc$+"\APP\MEDIUTIL\AIDElabo.dbf"+CHR$(0)
	ret%=CALL($0187,ADDR(pgname$)+1,ADDR(cmdl$),0,0,ADDR(pid%))
	IF ret%<0
		pgname$=LEFT$(pgname$,LEN(pgname$)-1)
		PRINT "NE PEUT LANCER",pgname$
		ext%=0
		PRINT ERR$(ret%) :RETURN Debut:
	ENDIF
	CALL($0688,pid%)
	RETURN Debut:
ENDP

PROC Prh: REM tableur
	LOCAL pgname$(40),disc$(2)
	LOCAL cmdl$(128),ret%
	IF EXIST ("\APP\MEDIUTIL\HONO.SPR")
		disc$=""
	ELSEIF EXIST ("A:\APP\MEDIUTIL\HONO.SPR")
		disc$="A:"
	ELSEIF EXIST ("B:\APP\MEDIUTIL\HONO.SPR")
		disc$="B:"
	ELSE
		ALERT ("HONO NON INSTALL�","\APP\MEDIUTIL\HONO.SPR EST N�CESSAIRE","CONTINUER")
		ext%=0
		RETURN Debut:
	ENDIF
	pgname$="ROM::sh3.app"+CHR$(0)
	cmdl$="Osh3"+CHR$(0)+".spr"+" "+CHR$(0)+disc$+"\APP\MEDIUTIL\hono.spr"+CHR$(0)
	ret%=CALL($0187,ADDR(pgname$)+1,ADDR(cmdl$),0,0,ADDR(pid%))
	IF ret%<0
		pgname$=LEFT$(pgname$,LEN(pgname$)-1)
		PRINT "NE PEUT LANCER",pgname$
		ext%=0
		PRINT ERR$(ret%) :RETURN Debut:
	ENDIF
	CALL($0688,pid%)
	RETURN Debut:
ENDP

PROC Prc: REM regime
	LOCAL pgname$(40),disc$(2)
	LOCAL cmdl$(128),ret%
	IF EXIST ("M:\APP\MEDIUTIL\regime.SPR")
		disc$=""
	ELSEIF EXIST ("A:\APP\MEDIUTIL\regime.SPR")
		disc$="A:"
	ELSEIF EXIST ("B:\APP\MEDIUTIL\regime.SPR")
		disc$="B:"
	ELSE
		ALERT ("R‚gime NON INSTALL�","\APP\MEDIUTIL\regime.SPR EST N�CESSAIRE","CONTINUER")
		ext%=0
		RETURN Debut:
	ENDIF
	pgname$="ROM::sh3.app"+CHR$(0)
	cmdl$="Osh3"+CHR$(0)+".spr"+" "+CHR$(0)+disc$+"\APP\MEDIUTIL\regime.spr"+CHR$(0)
	ret%=CALL($0187,ADDR(pgname$)+1,ADDR(cmdl$),0,0,ADDR(pid%))
	IF ret%<0
		pgname$=LEFT$(pgname$,LEN(pgname$)-1)
		PRINT "NE PEUT LANCER",pgname$
		ext%=0
		PRINT ERR$(ret%) :RETURN Debut:
	ENDIF
	CALL($0688,pid%)
	RETURN Debut:
ENDP

PROC Prv: REM VACCIN
	LOCAL pgname$(40),disc$(2)
	LOCAL cmdl$(128),ret%
	IF EXIST ("M:\APP\MEDIUTIL\VACCINS.SPR")
		disc$=""
	ELSEIF EXIST ("A:\APP\MEDIUTIL\VACCINS.SPR")
		disc$="A:"
	ELSEIF EXIST ("B:\APP\MEDIUTIL\VACCINS.SPR")
		disc$="B:"
	ELSE
		ALERT ("R‚gime NON INSTALL�","\APP\MEDIUTIL\VACCINS.SPR EST N�CESSAIRE","CONTINUER")
		ext%=0
		RETURN Debut:
	ENDIF
	pgname$="ROM::sh3.app"+CHR$(0)
	cmdl$="Osh3"+CHR$(0)+".spr"+" "+CHR$(0)+disc$+"\APP\MEDIUTIL\VACCINS.spr"+CHR$(0)
	ret%=CALL($0187,ADDR(pgname$)+1,ADDR(cmdl$),0,0,ADDR(pid%))
	IF ret%<0
		pgname$=LEFT$(pgname$,LEN(pgname$)-1)
		PRINT "NE PEUT LANCER",pgname$
		ext%=0
		PRINT ERR$(ret%) :RETURN Debut:
	ENDIF
	CALL($0688,pid%)
	RETURN Debut:
ENDP

PROC Pra: REM ordo
	LOCAL pgname$(40),disc$(2)
	LOCAL cmdl$(128),ret%
	IF EXIST ("\APP\MEDIUTIL\AIDEORDO.DBF")
		disc$=""
	ELSEIF EXIST ("A:\APP\MEDIUTIL\AIDEORDO.DBF")
		disc$="A:"
	ELSEIF EXIST ("B:\APP\MEDIUTIL\AIDEORDO.DBF")
		disc$="B:"
	ELSE
		ALERT ("BASE DE DONN�ES NON INSTALL�E","\APP\MEDIUTIL\AIDEORDO.DBF EST N�CESSAIRE","CONTINUER")
		ext%=0
		RETURN Debut:
	ENDIF
	pgname$="ROM::data.app"+CHR$(0)
	cmdl$="Odata"+CHR$(0)+".dbf"+" "+CHR$(0)+disc$+"\APP\MEDIUTIL\aideordo.dbf"+CHR$(0)
	ret%=CALL($0187,ADDR(pgname$)+1,ADDR(cmdl$),0,0,ADDR(pid%))
	IF ret%<0
		pgname$=LEFT$(pgname$,LEN(pgname$)-1)
		PRINT "NE PEUT LANCER",pgname$
		ext%=0
		PRINT ERR$(ret%) :RETURN Debut:
	ENDIF
	CALL($0688,pid%)
	RETURN Debut:
ENDP

PROC Pv:
	LOCAL lna,lk,lgly,lure,lcl,lbi
	dINIT "Iono"
	dFLOAT lna,"Natr‚mie",90,200
	dFLOAT lgly,"Glyc‚mie",2,60
	dFLOAT lk,"Kali‚mie",0,7
	dFLOAT lure,"Ur‚e",0,100
	dFLOAT LCL,"Chlore",70,150
	dFLOAT lbi,"Bicar",10,50
	dTEXT "","Tout en mmol/l"
	IF DIALOG
		AT 1,3
		PRINT "Natr‚mie corrig‚e =", INT(lna+(lgly-5.5)/3),"mmol/l"
		PRINT "(NA c=Na+(gly-5,5)/3)"
		IF lk<>0 AND lure<>0
			PRINT "Osmolarit‚ =",lna*2+lk*2+lgly+lure,"mmol/l"
			PRINT "(Os=Nax2 + K x2 + gly + ur‚e)"
		ENDIF
		IF LNA+LK-LCL-LBI>0
			PRINT "Indos‚s anioniques =",LNA+LK-LCL-LBI,"mmol/l"
			PRINT "(Na+K-Cl-HCO3)"
		ENDIF
	ELSE
		RETURN Debut:
	ENDIF
ENDP

PROC Po: REM ALCOOL
	LOCAL sex%,poi,galc,sex(2),sex$(2,5)
	sex(1)=.7
	sex(2)=.6
	sex$(1)="HOMME"
	sex$(2)="FEMME"
	dINIT "ALCOOL�MIE"
	sex%=1
	poi=20
	dCHOICE sex%,"SEXE","HOMME,FEMME"
	dFLOAT poi,"POIDS (en kg)",20,150
	dFLOAT galc,"NOMBRE DE VERRES",0,15
	dTEXT ""," ",$200
	dTEXT "","S'entend pour un grand verre de biŠre"
	dTEXT "","un verre moyen de vin ou"
	dTEXT "","un petit verre d'alcool fort"
	dTEXT "","soit 10g environ d'alcool pur par verre"
	IF DIALOG
		AT 1,3
		PRINT sex$(sex%),"DE",poi,"kg, AYANT BU",galc,"VERRES"
		galc=galc*10/(poi*sex(sex%))
		galc=INT(galc*100)
		galc=galc/100
		PRINT "ALCOOL�MIE TH�ORIQUE =",galc,"g/l"
		IF galc>.5
			print"conduite interdite"
		ELSE
			PRINT "CONDUITE AUTORIS�E"
		ENDIF
	ELSE
		RETURN Debut:
	ENDIF
ENDP

PROC Pj:
	LOCAL ca,alb
	dINIT "CALC�MIE CORRIG�E"
	dFLOAT ca,"CALCEMIE (mmol/l)",1,4
	dFLOAT alb,"ALBUMIN�MIE (g/l)",10,100
	IF DIALOG
		AT 1,3
		PRINT "CALC�MIE =",ca,"mmol/l"
		PRINT "ALBUMINE =",alb,"g/l"
		PRINT "CALC�MIE CORRIG�E = Ca+0.02*(40-ALB)"
		PRINT "CALC�MIE CORRIG�E =",ca+0.02*(40-alb),"mmol/l :",
		IF ca+0.02*(40-alb) <2.25
			PRINT "HYPOCALC�MIE"
		ELSEIF ca+0.02*(40-alb)>2.6
			PRINT "HYPERCALC�MIE"
		ELSE
			PRINT "NORMAL"
		ENDIF
	ELSE
		RETURN Debut:
	ENDIF
ENDP

PROC Pu:
	LOCAL tt,avt,ar,brg,brd,jbg,jbd,oge,suf,tt3,avt3,ar3,brg3,brd3,jbg3,jbd3,oge3,suf3
	dINIT "% DE SURFACE BRUL�E"
	dFLOAT tt,"TÒTE",0,100
	dFLOAT avt,"FACE AVANT DU TRONC",0,100
	dFLOAT ar,"FACE ARRIÔRE DU TRONC",0,100
	dFLOAT brg,"MEMBRE SUP�RIEUR GAUCHE",0,100
	dFLOAT brd,"MEMBRE SUP�RIEUR DROIT",0,100
	dFLOAT jbg,"MEMBRE INF�RIEUR GAUCHE",0,100
	dFLOAT jbd,"MEMBRE INF�RIEUR DROIT",0,100
	dFLOAT oge,"ORGANES G�NITAUX EXTERNES",0,100
	DIALOG
	suf=(tt*9+avt*18+ar*18+brg*9+brd*9+jbg*18+jbd*18+oge)/100
	AT 1,2
	PRINT "SURFACE BRêL�E =",suf;"%"
	PRINT "SELON LA RÔGLE DES 9"
	dINIT
	dtext"","Y A-T-IL DU 3Šme DEGR� ?"
	dBUTTONS "OUI",13,"NON",27
	IF DIALOG
		DEBUT::
		dINIT "% DE SURFACE BRUL�E AU 3Šme DEGR�"
		dFLOAT tt3,"TÒTE",0,100
		dFLOAT avt3,"FACE AVANT DU TRONC",0,100
		dFLOAT ar3,"FACE ARRIÔRE DU TRONC",0,100
		dFLOAT brg3,"MEMBRE SUP�RIEUR GAUCHE",0,100
		dFLOAT brd3,"MEMBRE SUP�RIEUR DROIT",0,100
		dFLOAT jbg3,"MEMBRE INF�RIEUR GAUCHE",0,100
		dFLOAT jbd3,"MEMBRE INF�RIEUR DROIT",0,100
		dFLOAT oge3,"ORGANES G�NITAUX EXTERNES",0,100
		DIALOG
	ENDIF
	suf3=(tt3*9+avt3*18+ar3*18+brg3*9+brd3*9+jbg3*18+jbd3*18+oge3)/100
	IF suf3>suf
		BEEP 5,300
		GIPRINT "IMPOSSIBLE ! SURFACE TOTALE TROP PETITE"
		GOTO DEBUT
	ENDIF
	PRINT "SCORE UBS =",suf3*3+suf,"(LIMITES 0 … 400)"
ENDP

PROC Ps:
	GLOBAL amj,hvp,mts,clc,mts2,nbr,phs,rsi%,tot%
	PRINT "MINI MENTAL SCORE"
	amj=5
	dINIT
	dTEXT "","EN QUELLE ANN�E SOMMES NOUS ?"
	dTEXT "","EN QUELLE SAISON ?"
	dTEXT "","EN QUEL MOIS ?"
	dTEXT "","QUEL JOUR DU MOIS ?"
	dTEXT "","QUEL JOUR DE LA SEMAINE ?"
	dFLOAT amj,"NOMBRE DE BONNES R�PONSES",0,5
	DIALOG
	hvp=5
	dINIT
	dTEXT "","O— NOUS SOMMES (HOPITAL...)?"
	dTEXT "","DANS QUELLE VILLE ?"
	dTEXT "","DANS QUEL D�PARTEMENT ?"
	dTEXT "","DANS QUEL PAYS ?"
	dTEXT "","A QUEL �TAGE SOMMES NOUS ICI ?"
	dFLOAT hvp,"NOMBRE DE BONNES R�PONSES",0,5
	DIALOG
	mts=3
	dINIT
	dTEXT "","JE VAIS VOUS DIRE 3 MOTS; JE VOUDRAIS QUE VOUS"
	dTEXT "","ME LES R�P�TIEZ ET QUE VOUS ESSAYIEZ DE LES"
	dTEXT "","RETENIR CAR JE VOUS LES REDEMANDERAI TOUT A L'HEURE",$200
	dTEXT "","CIGARE-FLEUR-PORTE OU CITRON-CL�-BALLON"
	dTEXT "","(Redire la liste en cas d'‚chec)"
	dFLOAT mts,"NOMBRE DE MOTS",0,3
	DIALOG
	clc=5
	dINIT
	dtext"","MAINTENANT, JE VAIS VOUS DEMANDER DE COMPTER"
	dtext"","EN ARRIERE DE 7 EN 7 A PARTIR DE 100",$200
	dtext"","93-86-79-72-65",2
	dTEXT "","SI IMPOSSIBLE",2
	dTEXT "","VOULEZ VOUS �PELER LE MOT MONDE A L'ENVERS ?"
	dTEXT "","E-D-N-O-M",$202
	dFLOAT clc,"NOMBRE DE BONNES R�PONSES",0,5
	DIALOG
	mts2=3
	dINIT
	dTEXT "","POUVEZ VOUS ME R�P�TER LES 3 MOTS"
	dTEXT "","QUE JE VOUS AI DITS TOUT A L'HEURE ?",$200
	dTEXT "","CIGARE-FLEUR-PORTE OU CITRON-CL�-BALLON"
	dFLOAT mts2,"NOMBRE DE MOTS",0,3
	DIALOG
	nbr=6
	dINIT
	dtext"montrer un crayon","QUEL EST LE NOM DE CET OBJET ?"
	dtext"montrer une montre","QUEL EST LE NOM DE CET OBJET ?"
	dtext"r‚p‚tez aprŠs moi","PAS DE MAIS, DE SI NI DE ET"
	dtext"faites ce que je dis","PRENEZ CETTE FEUILLE AVEC LA MAIN DTE"
	dtext" ","PLIEZ LA EN DEUX"
	dtext" ","ET JETEZ LA PAR TERRE"
	dFLOAT nbr,"Bonnes r‚ponses",0,6
	DIALOG
	phs=2
	dINIT
	dTEXT "","Tendre au sujet une feuille de papier sur laquelle"
	dTEXT "","est ‚crit ""Fermez les yeux"" et dire au sujet"
	dTEXT "","""FAITES CE QUI EST �CRIT""",$200
	dTEXT "","VOULEZ-VOUS M'�CRIRE UNE PHRASE, CE QUE VOUS VOULEZ"
	dTEXT "","MAIS UNE PHRASE ENTIÔRE",$200
	dTEXT "","(1 point si verbe + sujet)"
	dFLOAT phs,"Nombre de bonnes r‚ponses", 0,2
	DIALOG
	gCLS
	gAT 240,110
	gLINEBY -25,0
	gLINEBY 0,-60
	gLINEBY 25,-40
	gLINEBY 25,40
	gLINEBY 0,60
	gLINEBY -25,0
	gLINEBY 0,25
	gLINEBY 60,0
	gLINEBY 40,-25
	gLINEBY -40,-25
	gLINEBY -60,0
	gLINEBY 0,40
	gAT 10,20
	gFONT 11
	gSTYLE 0
	gPRINT "Voulez-vous recopier ce dessin"
	rsi%=2
	dINIT 
	dPOSITION 1,1
	dCHOICE rsi%,"R‚ussi ?","Non,Oui"
	DIALOG
	gCLS
	rsi%=rsi%-1
	tot%= amj+hvp+mts+clc+mts2+nbr+phs+rsi%
	PRINT "Total =",tot%,"sur 30 :",
	IF tot%>26
		PRINT "normal"
	ELSEIF tot%=25 OR tot%=26
		PRINT "limite"
	ELSEIF tot%>18 AND tot%<25
		PRINT "D‚t‚rioration l‚gŠre"
	ELSEIF tot%>9 AND tot%<19
		PRINT "D‚t‚rioration mod‚r‚e"
	ELSEIF tot%<10
		PRINT "D‚mence s‚vŠre"
	ENDIF
	PRINT "Orientation =",amj+hvp,"/10"
	PRINT "Aprentissage =",mts,"/3"
	PRINT "Attention =",clc,"/5"
	PRINT "M‚moire =",mts2,"/3"
	PRINT "Langage =",nbr+phs,"/8"
	PRINT "Activit‚ motrice =",rsi%,"/1"
ENDP

PROC Pf:
	LOCAL ct,chdl,tg,un%
	dINIT
	dCHOICE un%,"Unit‚","g/l,mmol/l"
	dFLOAT ct,"CHOLESTEROL TOTAL",0,10
	dFLOAT chdl,"CHOLESTEROL HDL",0,5
	dFLOAT tg,"TRIGLYCERIDES",0,4
	IF DIALOG
		AT 1,3
		PRINT "CHOLESTEROL TOTAL =",ct
		PRINT "HDL =",chdl
		PRINT "TRIGLYCERIDES =",tg
		IF un%=1
			PRINT "LDL = ct-hdl-tg/5"
			PRINT "CHOLESTEROL LDL =",ct-chdl-tg/5,"g/l",
			IF ct-chdl-tg/5<1.7
				PRINT ": NORMAL"
			ELSEIF ct-chdl-tg/5>=1.7 AND  ct-chdl-tg/5<2.2
				PRINT ": RISQUE MOD�R�"
			ELSE
				PRINT ": RISQUE ATH�ROGÔNE S�VÔRE"
			ENDIF
		ELSEIF un%=2
			PRINT "LDL = ct-hdl-tg/2.2"
			PRINT "CHOLESTEROL LDL =",ct-chdl-tg/2.2,"mmol/l",
			IF ct-chdl-tg/2.2<4.1
				PRINT ": NORMAL"
			ELSEIF ct-chdl-tg/2.2>=4.1 AND  ct-chdl-tg/2.2<5.7
				PRINT ": RISQUE MOD�R�"
			ELSE
				PRINT ": RISQUE ATH�ROGÔNE S�VÔRE"
			ENDIF
		ENDIF
	ELSE
		RETURN Debut:
	ENDIF
ENDP

PROC Pk:
	LOCAL t%,nb
	gUSE 1
	gCLS
	gFONT 8
	gSTYLE 9
	gBORDER 3
	dINIT "Calculs de fr‚quence"
	dTEXT "","APPUYEZ SUR ENTR�E",2
	dTEXT "","ET COMPTEZ EN COMMEN‡ANT PAR 0"
	IF DIALOG
		gAT 20,150
		gPRINT "APPUYEZ SUR UNE TOUCHE POUR ARRÒTER"
		DO
			IF KEY
				BREAK
			ENDIF
			gAT 230,70
			gXPRINT NUM$(t%,2),0
			PAUSE 20
			IF KEY
				BREAK
			ENDIF
			t%=t%+1
		UNTIL t%=60
		BEEP 5,300
		gCLS
		dINIT
		dFLOAT nb,"NOMBRE TROUV�",1,300
		IF DIALOG
			gAT 20,80
			gPRINT "FR�QUENCE =",INT(nb*60/t%),"/mn"
		ELSE
			RETURN Debut:
		ENDIF
	ELSE
		RETURN Debut:
	ENDIF
ENDP

PROC Pr:
	LOCAL p0,p1,p2,ir,k%,id%
	print"indice de ruffier-dickson"
	AT 1,5
	print"pensez … activer"
	print"les sons"
	dinit"prenez le pouls"
	dBUTTONS "D�BUT",13
	IF DIALOG
		CLS
		AT 1,3
		PRINT "POULS AVANT EFFORT"
		AT 1,7
		print"comptez les pulsations jusqu'au bip"
		print"esc pour interrompre"
		k%=0
		id%=Barinit%:
		DO
			k%=k%+1
			PAUSE 20
			Bargraph:(id%,k%,15)
			IF KEY=27
				RETURN Debut:
			ENDIF
		UNTIL k%=15
		CLS
		BEEP 10,300
	ELSE
		RETURN Debut:
	ENDIF
	dINIT
	dFLOAT p0,"PULSATIONS TROUV�ES",7,80
	dBUTTONS "D�BUT DES FLEXION",13
	IF DIALOG=0
		RETURN Debut:
	ELSE
		AT 1,4
		CLS
		PRINT "1 FLEXION PAR BIP JUSQU'AU SIGNAL"
		PRINT "Les flexions doivent ˆtre faites buste droit"
		PRINT "Talons au sol"
		AT 1,7
		PRINT "En descendant les fesses jusqu'aux talons"
		print"esc pour interrompre"
		p0=4*p0
		k%=0
		id%=Barinit%:
		DO
			PAUSE 29
			Bargraph:(id%,k%,29)
			IF KEY=27
				RETURN Debut:
			ENDIF
			BEEP 1,300
			k%=k%+1
		UNTIL k%=30
		CLS
		Plays:("ROM::SYS$AL03.WVE",45)
	ENDIF
	dINIT "POULS APRÔS EFFORT"
	dBUTTONS "COMMENCER",13
	IF DIALOG=0
		RETURN Debut:
	ELSE
		CLS
		print"comptez les pulsations jusqu'au bip"
		print"esc pour interrompre"
		k%=0
		id%=Barinit%:
		DO
			k%=k%+1
			Bargraph:(id%,k%,15)
			IF KEY=27
				RETURN Debut:
			ENDIF
			PAUSE 20
		UNTIL k%=15
		BEEP 10,300
		CLS
	ENDIF
	dINIT
	dFLOAT p1,"POULS APRÔS EFFORT",7,55
	IF DIALOG=0
		RETURN Debut:
	ELSE
		p1=4*p1
		CLS
		PRINT "REPOS JUSQU'AU BIP"
		print"esc pour interrompre"
		k%=0
		id%=Barinit%:
		DO
			k%=k%+1
			PAUSE 60
			IF KEY=27
				RETURN Debut:
			ENDIF
			Bargraph:(id%,k%,15)
		UNTIL k%=15
		BEEP 10,300
	ENDIF
	CLS
	dINIT "POULS APRÔS REPOS"
	dBUTTONS "COMMENCER",13
	IF DIALOG=0
		RETURN Debut:
	ELSE
		print"comptez les pulsations jusqu'au bip"
		print"esc pour interrompre"
		k%=0
		id%=Barinit%:
		DO
			k%=k%+1
			IF KEY=27
				RETURN Debut:
			ENDIF
			Bargraph:(id%,k%,15)
			PAUSE 20
		UNTIL k%=15
		BEEP 10,300
		CLS
	ENDIF
	dINIT
	dFLOAT p2,"POULS APRÔS REPOS",7,50
	IF DIALOG=0
		RETURN Debut:
	ELSE
		p2=4*p2
		ir=((p1-70)+(p2-p0)) /10
		PRINT "POULS AU REPOS =",p0,"/mn"
		PRINT "POULS APRÔS EFFORT =",p1,"/mn"
		PRINT "POULS APRÔS REPOS =",p2,"/mn"
		PRINT "INDICE DE RUFFIER-DICKSON =",ir,
		IF ir<3
			PRINT ": BON"
		ELSEIF ir>=3 AND ir<6
			PRINT ": MOYEN"
		ELSEIF ir>=6 AND ir <8
			PRINT ": M�DIOCRE"
		ELSEIF ir>8
			PRINT ": MAUVAIS"
		ENDIF
	ENDIF
ENDP

PROC Barinit%:
	LOCAL id%
	gUSE 1
	id%=gCREATE((gWIDTH-320)/2,60,320,40,1,1)
	gXBORDER 1,3
	gAT 10,10
	gGREY 1 :gFILL 300,20,0
	gGREY 0 :gBOX 300,20
	RETURN id%
ENDP

PROC Bargraph:(id%,val%,max%)
	gUSE id%
	gFILL val%*(300.0/max%),20,0
	IF val%=max%
		gCLOSE id%
	ENDIF
ENDP

PROC Pe:
	LOCAL poi$(2,48),tail$(2,48),ag%,sex%,sex$(2,6)
	poi$(1)="100125145165195220245275300325350385420490545590"
	poi$(2)="100125145165190210235265290320355395450490515530"
	tail$(1)=" 75 87 96103111117124130135140144150155163168172"
	tail$(2)=" 74 87 96103110116122128133139145152157160161162"
	sex$(1)="GAR‡ON"
	sex$(2)="FILLE"
	dINIT "CROISSANCE ENFANTS"
	dCHOICE ag%,"AGE EN ANN�ES","1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16"
	dCHOICE sex%,"SEXE","GAR‡ON,FILLE"
	IF DIALOG
		AT 1,5
		PRINT sex$(sex%),"DE",ag%,"AN(S)"
		PRINT "Poids th‚orique=",MID$(poi$(sex%),3*ag%-2,2);",";MID$(poi$(sex%),3*ag%,1),"kg"
		PRINT "Taille th‚orique=",MID$(tail$(sex%),3*ag%-2,3),"cm"
	ELSE
		RETURN Debut:
	ENDIF
ENDP

PROC Pb:
	LOCAL poi$(2,26),ag%,tail$(2,26),sex%,sex$(2,6)
	poi$(1)="35405057657075808589929598"
	poi$(2)="34394653606772768084879093"
	tail$(1)="50535660626466686971727374"
	tail$(2)="50535659616365676869707273"
	sex$(1)="GAR‡ON"
	sex$(2)="FILLE"
	dINIT "POIDS NOURRISSON"
	dCHOICE ag%,"Age (mois)","Naissance,1,2,3,4,5,6,7,8,9,10,11,12"
	dCHOICE sex%,"SEXE","GAR‡ON,FILLE"
	IF DIALOG
		AT 1,5
		PRINT sex$(sex%),"DE",ag%-1,"MOIS"
		PRINT "POIDS TH�ORIQUE =",MID$(poi$(sex%),ag%*2-1,1)+","+MID$(poi$(sex%),ag%*2,1),"kg"
		PRINT "TAILLE TH�ORIQUE =",MID$(tail$(sex%),ag%*2-1,2),"cm"
	ELSE 
		RETURN Debut:
	ENDIF
ENDP

PROC Pc:
	LOCAL l%,a$(6)
	dINIT "CR�ATININE"
	dTEXT "","CLEARANCE ESTIM�E (COCKROFT)",$400
	dTEXT "","CLEARANCE VRAIE (N�CESSITE LE DOSAGE URINAIRE)",$400
	l%=DIALOG
	IF l%=0
		RETURN Debut:
	ELSE
		a$="creat"+NUM$(l%,1)
		@(a$):
	ENDIF
ENDP

PROC Creat3:
	LOCAL cu,cs,vol,dur,clear
	dur=24
	dinit"creatinine"
	dFLOAT cs,"CREATININ�MIE ",1,2000
	dFLOAT cu,"CREATININURIE ",1,99999
	dTEXT "","(mˆme unit‚)"
	dFLOAT vol,"VOLUME URINAIRE (litres)",0,5
	dFLOAT dur,"DUR�E DU RECUEIL (heures)",1,24
	IF DIALOG
		clear=INT((cu*vol*24)/(cs*1.44*dur))
		AT 1,4
		PRINT "CREATININEMIE =",cs
		PRINT "CREATININURIE =",cu
		PRINT "DIURÔSE DES 24 h =",vol*24/dur,"l"
		PRINT "CREATININURIE DES 24 h =",cu*vol*24/dur
		PRINT "CLEARANCE DE LA CREATININE =",clear,"ml/mn"
		Creat:(clear)
	ELSE
		RETURN Debut:
	ENDIF
ENDP

PROC Creat2:
	LOCAL sex,age,poi,crea,sex%,crea%,clear
	poi=70
	age=20
	dINIT "CLEARANCE ESTIM�E DE LA CREATININE"
	dCHOICE sex%,"QUEL EST LE SEXE DU PATIENT?","FEMME,HOMME"
	dFLOAT poi, "QUEL EST SON POIDS?",5,200
	dFLOAT age,"QUEL EST SON AGE?",1,125
	dCHOICE crea%,"EN QUELLE UNIT� EST EXPRIM�E LA CREATININEMIE?","mg/l,mmol/l"
	dFLOAT crea,"QUELLE EST LA CREATININEMIE?",1,500
	IF DIALOG
		IF sex%=1
			sex=.85
		ELSEIF sex%=2
			sex=1
		ENDIF
		IF crea%=2
			clear=INT(sex*(140-age)*poi/(.814*crea))
		ELSEIF crea%=1
			clear=INT(sex*(140-age)*poi/(7.2*crea))
		ENDIF
	ELSE
		RETURN Debut:
	ENDIF
	AT 1,5
	PRINT "CLEARANCE DE LA CREATININE =",clear," ml/mn"
	PRINT "(SELON LA FORMULE DE COCKROFT)"
	Creat:(clear)
ENDP

PROC Creat:(clear)
	IF clear>100
		PRINT "R�SULTAT NORMAL"
	ELSE
		PRINT "Insuffisance r‚nale",
		IF clear>50
			PRINT "mod‚r‚e"
		ELSEIF clear>=15
			PRINT "s‚vŠre"
		ELSEIF clear <15
			PRINT "trŠs grave"
		ENDIF
	ENDIF
ENDP

PROC Pn:
	LOCAL vgm,ht,ng,hgb
	LOCAL glob,neut,eos,bas,mon,lym
	PRINT "NFS"
	dINIT
	dFLOAT ng,"HEMATIES (millions/mmü)",1,10
	dFLOAT ht,"HEMATOCRITE (%)",15,60
	dFLOAT hgb,"HEMOGLOBINE (g/dl)",4,20
	dFLOAT glob,"LEUCOCYTES/mmü",200,100000
	dFLOAT neut,"NEUTROPHILES (%)",0,100
	dFLOAT eos,"EOSINOPHILES",0,100
	dFLOAT bas,"BASOPHILES",0,100
	dFLOAT lym,"LYMPHOCYTES",0,100
	dFLOAT mon,"MONOCYTES",0,100
	IF DIALOG
		vgm=INT(ht/ng*10)
		FONT 4,0
		PRINT "HEMATIES =",ng,"million(s)/mmü",
		IF ng>6
			PRINT ": Polyglobulie: HEMOCONCENTRATION, VAQUEZ"
		ELSE
			PRINT ""
		ENDIF
		PRINT "HEMATOCRITE =",ht,"%"
		PRINT "HEMOGLOBINE =",hgb,"g/dl",
		IF hgb<12
			PRINT ": An‚mie"
		ELSEIF hgb<18
			PRINT ": Normal"
		ELSE
			PRINT ""
		ENDIF
		PRINT "VGM =",vgm,"æü",
		IF vgm<82
			PRINT ": Microcytose"
			IF ng>6
				PRINT ""
			ELSE
				PRINT ""
			ENDIF
		ELSEIF vgm>98
			PRINT ": Macrocytose"
			IF ng>6
				PRINT "VAQUEZ, SPLENOMEGALIE MYEOLIDE, INSUFFISANCE RESPIRATOIRE, SHUNT DROIT GAUCHE, ALTITUDE, METHEMOGLOBINEMIE, CANCER REIN, FIBROME UTERIN, CANCER OVAIRE"
			ENDIF
		ELSE
			PRINT ": Normal"
		ENDIF
		PRINT "CCMH =",INT(hgb*100/ht),"g/dl",
		IF INT(hgb*100/ht)<31
			PRINT ": Hypochromie"
		ELSE
			print": normal"
		ENDIF
		PRINT "TCMH =",INT(hgb*10/ng),"pg"
		PRINT "TOTAL LEUCO =",neut+eos+bas+mon+lym,"%"
		PRINT "LEUCOCYTES =",glob,"/mmü :",
		IF glob<4000
			PRINT "LEUCOPENIE"
		ELSEIF glob>10000
			PRINT "HYPERLEUCOCYTOSE"
		ELSE
			PRINT "NORMAL"
		ENDIF
		PRINT "NEUTROPHILES =",glob*neut/100,"/mmü :",
		IF glob*neut/100<1800
			PRINT "NEUTROPENIE"
		ELSEIF glob*neut/100>7000
			PRINT "POLYNUCLEOSE NEUTROPHILE : INFECTIONS, NECROSES, HEMORRAGIE, RHUMATISMES, MEDICAMENTS, TABAC, LEUCEMIES"
		ELSE
			PRINT "NORMAL"
		ENDIF
		PRINT "EOSINOPHILES =",glob*eos/100,"/mmü :",
		IF glob*eos/100>300
			PRINT "HYPEREOSINOPHILIE : HELMINTHES, ALLERGIES, PAN, LEUCEMIES, CANCERS"
		ELSE
			PRINT "NORMAL"
		ENDIF
		PRINT "BASOPHILES =",glob*bas/100,"/mmü :",
		IF glob*bas/100>50
			PRINT "HYPERBASOPHILIE : LEUCEMIES, HYPOTHYROIDIE, HYPERLIPIDEMIE"
		ELSE
			PRINT "NORMAL"
		ENDIF
		PRINT "LYMPHOCYTES =",glob*lym/100,"/mmü :",
		IF glob*lym/100<1500
			PRINT "LYMPHOPENIE"
		ELSEIF glob*lym/100>4000
			PRINT "HYPERLYMPHOCYTOSE : LEUCEMIES, HEPATITE, BRUCELLOSE, CANCERS, OREILLONS, VARICELLE, WALDENSTR™M, COQUELUCHE, MNI"
		ELSE
			PRINT "NORMAL"
		ENDIF
		PRINT "MONOCYTES =",glob*mon/100,"/mmü :",
		IF glob*mon/100>700
			PRINT "MONOCYTOSE : INFECTIONS, PARASITOSES, INFLAMMATIONS"
		ELSE
			PRINT "NORMAL"
		ENDIF
		PRINT "(Normales chez l'homme adulte)"
	ELSE
		RETURN Debut:
	ENDIF
ENDP

PROC Pw:
	LOCAL tr%,des%,app%
	dINIT "SCORE DE GLASGOW"
	dCHOICE tr%,"OUVERTURE DES YEUX","4 SPONTAN�E,3 AU BRUIT,2 A LA DOULEUR,1 JAMAIS"
	dCHOICE des%,"R�PONSE VERBALE","5 NORMALE,4 CONFUSE,3 INAPPROPRI�E,2 INCOMPR�HENSIBLE,1 AUCUNE"
	dCHOICE app%,"R�PONSE MOTRICE","6 SUR ORDRE,5 LOCALIS�E,4 �VITEMENT,3 EN FLEXION,2 EN EXTENSION, 1 AUCUNE"
	IF DIALOG
		AT 1,5
		PRINT "GLASGOW =",18-tr%-des%-app%,"(EXTRÔMES ENTRE 3 ET 15)"
		IF 18-tr%-des%-app%<=8
			PRINT "INTUBATION RECOMMAND�E"
		ENDIF
	ELSE
		RETURN Debut:
	ENDIF
ENDP

PROC Pl:
	LOCAL par%,tra%,dcon%,icon%,eau%
	dINIT "SCORE DE MALINAS"
	dCHOICE par%,"PARIT�","0 : 1,1 : 2,2 : 3 ET PLUS"
	dCHOICE tra%,"DUR�E DU TRAVAIL","0 : <3h,1 : 3 … 5 h,2 : >5h"
	dCHOICE dcon%,"DUR�E DES CONTRACTIONS","0 : <1 mn,1 : 1 mn,2 : >1 mn"
	dCHOICE icon%,"INTERVALLE ENTRE LES CONTRACTIONS","0 : >5 mn,1 : 3 … 5 mn,2 : <3 mn"
	dCHOICE eau%,"PERTE DES EAUX","0: NON,1: R�CENTE,2: >1h"
	IF DIALOG
		AT 1,5
		PRINT "SCORE DE MALINAS =",par%+tra%+dcon%+icon%+eau%-5,"(EXTRÔMES ENTRE 0 ET 10)"
		IF par%+tra%+dcon%+icon%+eau%>9
			PRINT "(>=5 : ACCOUCHEMENT IMMINENT)"
		ENDIF
	ELSE
		RETURN Debut:
	ENDIF
ENDP

PROC Pa:
	LOCAL tr%,des%,app%,ton%,rea%
	tr%=3
	des%=3
	app%=3
	ton%=3
	rea%=3
	dINIT "SCORE D'APGAR"
	dCHOICE tr%,"FR�QUENCE CARDIAQUE","0 : <80/mn,1 : 80 … 100/mn,2 : >100/mn"
	dCHOICE des%,"RESPIRATION","0 ABSENTE,1 FAIBLE ET IRREGULIÔRE,2 EFFICACE"
	dCHOICE app%,"COLORATION","0 BLANCHE OU BLEUE,1 CYANOSE P�RIPHERIQUE,2 ROSE"
	dCHOICE ton%,"TONUS","0 NUL,1 FAIBLE DES EXTREMIT�S,2 NORMAL"
	dCHOICE rea%,"R�ACTIVIT�","0 NULLE,1 INSUFFISANTE,2 VIVE"
	IF DIALOG
		AT 3,5
		PRINT "APGAR =",tr%+des%+app%+ton%+rea%-5,"(EXTRÔMES ENTRE 0 ET 10)"
	ELSE
		RETURN Debut:
	ENDIF
ENDP

PROC Pg:
	LOCAL x&,imp%,nb%
	LOCAL dd&(14),dd%,nb$(3,30),ja$(14,10)
	GLOBAL j$(10),jo%,mo%,an%
REM	IF NOT EXIST ("M:\APP\MEDIUTIL")
REM		ALERT ("ATTENTION ! CR�ER UN REPERTOIRE","\APP\MEDIUTIL\","CONTNUER")
REM		RETURN DEBUT:
REM	ENDIF
	FONT 4,0
	gBORDER 3
	SCREEN 58,16
	dd&(1)=25567
	nb$(1)="PremiŠre ou deuxiŠme grossesse"
	nb$(2)="TroisiŠme grossesse ou plus"
	nb$(3)="Grossesse gemellaire"
	dINIT "GROSSESSE"
	dTEXT " "," "
	dDATE dd&(1),"DATE DES DERNIÔRES  RÔGLES",25567,40000
	dCHOICE nb%,"Parit‚","1er ou 2 Šme,3Šme ou plus,jumeaux"
	IF DIALOG
		dd&(2)=dd&(1)+14
		dd&(3)=dd&(1)+91
		dd&(4)=dd&(1)+224
		dd&(5)=dd&(1)+238
		dd&(6)=dd&(1)+210
		dd&(7)=dd&(1)+182
		dd&(8)=dd&(1)+196
		dd&(9)=dd&(1)+259
		dd&(10)=dd&(1)+280
		dd&(11)=dd&(1)+287
		dd&(12)=dd&(1)+350
		dd&(13)=dd&(1)+406
		dd&(14)=dd&(1)+434
		Calc:(dd&(1)) :ja$(1)=j$
		dd%=1
		DO
			dd%=dd%+1
			Calc:(dd&(dd%)) :ja$(dd%)=j$
		UNTIL dd%=14
		IF NOT EXIST ("\APP\MEDIUTIL\GROSSESS.TXT")
		TRAP MKDIR ("M:\APP\MEDIUTIL\")
			CREATE "\APP\MEDIUTIL\GROSSESS.TXT",a,Z1
			CLOSE
		ENDIF
		TRAP LOPEN "\APP\MEDIUTIL\GROSSESS.TXT"
		IF ERR
			ALERT ("LE FICHIER \APP\MEDIUTIL\GROSSESS.TXT","DOIT ÒTRE FERM�","CONTINUER")
			RETURN Debut:
		ENDIF
		Calc:(dd&(1)) :ja$(1)=j$
		LPRINT "le",DAY,"/",MONTH,"/",YEAR
		LPRINT "Calendrier de grossesse de Madame"
		LPRINT "Date des derniŠres rŠgles le",ja$(1)
		LPRINT nb$(nb%)
		IF INT((DAYS(DAY,MONTH,YEAR)-DAYS(jo%,mo%,an%))/7)<44 AND INT((DAYS(DAY,MONTH,YEAR)-DAYS(jo%,mo%,an%))/7)>0
			LPRINT "Terme actuel :",INT((DAYS(DAY,MONTH,YEAR)-DAYS(jo%,mo%,an%))/7),"semaines d'am‚norrh‚e r‚volues"
			IF nb%<3
				LPRINT "Hauteur ut‚rine th‚orique pour le terme =",
				IF an%=YEAR
					IF MONTH-mo%<8
						LPRINT (MONTH-mo%)*4,"cm"
					ELSE
						LPRINT 28+(MONTH-mo%-7)*2,"cm"
					ENDIF
				ELSE
					IF 12-(mo%-MONTH)<8
						LPRINT (12-(mo%-MONTH))*4,"cm"
					ELSE
						LPRINT 28+(12-(mo%-MONTH))*2,"cm"
					ENDIF
				ENDIF
			ENDIF
		ENDIF
		LPRINT "D‚but de grossesse le",ja$(2)
		LPRINT "D‚claration s‚cu avant le",ja$(3)
		IF nb%=1
			LPRINT "Cong‚ pour grossesse pathologique … partir du",ja$(4),"(8 semaines avant l'accouchement)"
			LPRINT "Cong‚ maternit‚ et d‚claration employeur :",ja$(5),"(6 semaines avant l'accouchement)"
		ELSEIF nb%=2
			LPRINT "Cong‚ pour grossesse pathologique … partir du",ja$(6),"(10 semaines avant l'accouchement)"
			LPRINT "Cong‚ maternit‚ et d‚claration employeur :",ja$(4),"(8 semaines avant l'accouchement)"
		ELSEIF nb%=3
			LPRINT "Cong‚ pour grossesse pathologique … partir du",ja$(7),"(14 semaines avant l'accouchement)"
			LPRINT "Cong‚ maternit‚ et d‚claration employeur :",ja$(8),"(12 semaines avant l'accouchement)"
		ENDIF
		LPRINT "Pr‚matur‚ jusqu'au",ja$(9),"(37 semaines d'am‚norrh‚e)"
		LPRINT "Terme pr‚vu le",ja$(10),"(40 semaines d'am‚norrh‚e)"
		LPRINT "Terme d‚pass‚ … partir du",ja$(11),"(42 semaines)"
		IF nb%=1
			LPRINT "Cong‚ post natal jusqu'au",ja$(12),"(10 semaines aprŠs l'accouchement)"
		ELSEIF nb%=2
			LPRINT "Cong‚ post natal jusqu'au",ja$(13),"(18 semaines aprŠs l'accouchement)"
		ELSEIF nb%=3
			LPRINT "Cong‚ post natal jusqu'au",ja$(14),"(22 semaines aprŠs l'accouchement)"
		ENDIF
		LPRINT "Consultations obligatoires durant le 6ø mois et durant les 15 premiers jours du 8ø mois "
		LCLOSE
		Word:
		RETURN Debut:
	ELSE
		RETURN Debut:
	ENDIF
ENDP

PROC Calc:(d&)
	LOCAL hr%,mn%,sc%,anj%
	SECSTODATE (d&-25567)*86400,an%,mo%,jo%,hr%,mn%,sc%,anj%
	j$=NUM$(jo%,2)+" "+NUM$(mo%,2)+" "+NUM$(an%,4)
ENDP

PROC Word:
	LOCAL fname$(128),pgname$(40)
	LOCAL cbyte$(1),cmdl$(128),ret%
	ext%=1
	fname$="grossess.txt"
	cbyte$="O"
	pgname$="ROM::WORD.app"+CHR$(0)
	cmdl$=cbyte$+"WORD"+CHR$(0)+".wrd"+" "+CHR$(0)+"\app\mediutil\"+fname$+CHR$(0)
	ret%=CALL($0187,ADDR(pgname$)+1,ADDR(cmdl$),0,0,ADDR(pid%))
	IF ret%<0
		pgname$=LEFT$(pgname$,LEN(pgname$)-1)
		PRINT "NE PEUT LANCER",pgname$
		ext%=0
		PRINT ERR$(ret%) :RETURN REM :get :continue
	ENDIF
	CALL($0688,pid%)
ENDP

PROC Pm:
	LOCAL p,t,s,m
	dINIT "SURFACE ET INDICE DE MASSE CORPORELLE"
	dFLOAT p,"POIDS (kg)",2,200
	dFLOAT t,"TAILLE (cm)",50,220
	IF DIALOG
		s=INT((p**.425)*(t**.725)*71.84)
		AT 1,2
		PRINT "Poids =",p,"kg"
		PRINT "Taille =",t,"cm"
		PRINT " "
		PRINT "SURFACE CORPORELLE =",s/10000,"mý"
		PRINT "(selon la formule de Du Bois)"
		m=INT(p*10000/(t**2))
		PRINT ""
		PRINT "INDICE DE QUETELET =",m,
		IF m<26 :PRINT ": poids normal (IMC<26)"
		ELSEIF m>=26 AND m<=30 :print": surpoids"
		ELSEIF m>30 AND m<=35 :print": ob‚sit‚ franche"
		ELSEIF m>=35 :print": ob‚sit‚ morbide"
		ENDIF
	ELSE
		RETURN Debut:
	ENDIF
ENDP

PROC Ph:
	LOCAL tr%,des%,app%,las%,conc%,att%,anxps%,anxso%,inso%,dev%,suic%,delir%,hx%,ax%,dx%,rx%
	gFONT 8
	gSTYLE 1
	gAT 100,30
	gPRINT "DIAGRAMME H.A.R.D SIMPLIFI�"
	gAT 50,150
	gSTYLE 0
	gPRINT "D'APRÔS FERRERI ET RUFIN"
	dINIT "HUMEUR"
	dCHOICE tr%,"TRISTESSE","0 ABSENTE,1,2 D�COURAG�,3,4 PESSIMISME-TRISTESSE APPARENTE-PLEURS,5,6 SENTIMENT PREGNANT DE D�SESPOIR"
	dCHOICE des%,"D�SINTERET","0 INT�RET HABITUEL POUR AUTRUI,1,2MOINDRE GOUT POUR SES PLAISIRS HABITUELS,3,4 PERTE DE SOLLICITUDE POUR LES PROCHES,5,6 REPLI SUR SA PR�OCCUPATION-INERTIE DOULOUREUSE"
	dCHOICE app%,"APPETIT","0 NORMAL,1,2 L�GEREMENT REDUIT,3,4 NOURRITURE SANS GOUT,5,6 NE MANGE QUE SI ON L'INVIGORE"
	IF DIALOG
		hx%=tr%+des%+app%-3
	ELSE
		RETURN Debut:
	ENDIF
	dINIT "RALENTISSEMENT"
	dCHOICE las%,"LASSITUDE","0 ABSENTE,1,2 DIFFICULT� A ENTREPRENDRE-ASTH�NIE MATINALE,3,4 SENTIMENT P�NIBLE D'EFFORT-IMPRESSION D'ÒTRE VID�,5,6 LASSITUDE EXTRÔME-�PUISEMENT PERMANENT"
	dCHOICE conc%,"CONCENTRATION","0 PAS DE DIFFICULT�,1,2 EFFORT INHABITUEL,3,4 BAISSE DES CAPACIT�S INTELLECTUELLES,5,6 TROUBLES GÔNANT L'ENTRETIEN-DIFFICULT� DE COMPR�HENSION"
	dCHOICE att%,"ATTITUDE","0 PAS DE RALENTISSEMENT,1,2 MIMIQUE LANGAGE OU MARCHE RALENTIS,3,4 MIMIQUE LANGAGE OU MARCHE TRÔS RALENTIS ,5,6 RALENTISSEMENT QUI GÔNE L'ENTRETIEN"
	IF DIALOG
		rx%=las%+conc%+att%-3
	ELSE
		RETURN Debut:
	ENDIF
	dINIT "ANGOISSE"
	dCHOICE anxps%,"ANXI�T� PSYCHIQUE","0 CALME,1,2 INQUIÔTUDE-TENSION PASSAGÔRE INHABITUELLE,3,4 SENTIMENT PERMANENT DE TENSION INT�RIEURE,5,6 ANXI�T� MAJEURE DURABLE-D�SARROI"
	dCHOICE anxso%,"ANXI�T� SOMATIQUE","0 ABSENTE,1,2 DISCRÔTE-PR�OCCUPATIONS CORPORELLES-ALGIES DIVERSES,3,4 MOYENNE-SERREMENTS-SUFOCATION-C�PHAL�ES,5,6 ANGOISSE IMPORTANTE-PERMANENTE ET INCAPACITANTE"
	dCHOICE inso%,"INSOMNIE","0 SOMMEIL NORMAL,1,2 INSOMNIE D'ENDORMISSEMENT,3,4 R�VEILS FR�QUENTS D'AU MOINS 2h-CAUCHEMARDS,5,6 MOINS DE 3 H DE SOMMEIL PAR 24H"
	IF DIALOG
		ax%=anxps%+anxso%+inso%-3
	ELSE
		RETURN Debut:
	ENDIF
	dINIT "DANGER"
	dCHOICE dev%,"D�VALORISATION","0 AUCUNE,1,2 SENTIMENT D'INF�RIORIT�-PERTE DE L'ESTIME DE SOI,3,4 PROPOS INQUIÔTANTS DE D�VALORISATION(JE NE VAUX RIEN),5,6 ID�ES D�LIRANTES D'AUTO D�PR�CIATION(JE SUIS UN D�TRITUS)"
	dCHOICE suic%,"ID�ES SUICIDAIRES","0 AUCUNE,1,2 S'INTERROGE SUR LA N�CESSIT� DE VIVRE,3,4 ID�ES NOIRES-SUICIDE �VOQU�,5,6 INTENTIONS SUICIDAIRES MANIFESTES-TS R�CENTE"
	dCHOICE delir%,"ID�ES D�LIRANTES","0 AUCUNE,1,2 D�FORMATION DE LA R�ALIT�-VOIT TOUT EN NOIR,3,4 VISION ALT�R�E DU MONDE-SOUP‡ON DRAME,5,6 AUTO ACCUSATION FRANCHE PERS�CUTION HALLUCINATIONS"
	IF DIALOG
		dx%=dev%+suic%+delir%-3
	ELSE
		RETURN Debut:
	ENDIF
	gCLS
	gFONT 11
	gAT 240-4*hx%,80-4*hx%
	gLINEBY 4*(hx%+rx%),4*(hx%-rx%)
	gLINEBY 4*(-rx%+ax%),4*(rx%+ax%)
	gLINEBY -4*(ax%+dx%),4*(dx%-ax%)
	gLINEBY 4*(dx%-hx%),-4*(dx%+hx%)
	gAT 240,80
	gLINEBY 0,0
	gAT 237,86
	gPRINT "O"
	gAT 30,20
	gPRINT "HUMEUR =",hx%,"SUR 18"
	gAT 320,20
	gPRINT "RALENTISSEMENT =",rx%
	gAT 330,35
	gPRINT "SUR 18"
	gAT 320,150
	gPRINT "ANXI�T� =",ax%,"SUR 18"
	gAT 30,150
	gPRINT "DANGER =",dx%,"SUR 18"
	gAT 320,80
	gPRINT "TOTAL =",tr%+des%+app%+las%+conc%+att%+anxps%+anxso%+inso%+dev%+suic%+delir%-12,"SUR 72"
	gAT 320,100
	gPRINT "(NORMAL = 0 PARTOUT)"
ENDP

PROC Pd:
	LOCAL p,d,iv,n
	dINIT "POSOLOGIES JOURNALIERES"
	dFLOAT p,"POIDS (kg)",2,200
	dFLOAT d,"DOSE JOURNALIÔRE (mg/kg.j)",1,3000
	dFLOAT n,"NOMBRE DE PRISES",1,5
	IF DIALOG
		iv=INT(p*d/n)
		AT 1,5
		PRINT "Poids =",p,"kg"
		PRINT "Dose =",d,"mg/kg.j"
		PRINT "DOSE PAR PRISE =",iv,"mg"
		PRINT "Pour",n,"prise(s) parjour"
	ELSE
		RETURN Debut:
	ENDIF
ENDP

PROC Pp:
	LOCAL ag%,tai%,sex%
	LOCAL pf$(7,45)
	dINIT "PERSONNE"
	dCHOICE sex%,"SEXE","HOMME,FEMME,GAR‡ON,FILLE"
	IF DIALOG
		IF sex%=1
			dINIT "PEAK FLOW HOMME"
			dCHOICE tai%,"TAILLE EN cm","160,165,170,175,180,185,190"
			dCHOICE ag%,"AGE","15,20,25,30,35,40,45,50,55,60,65,70,75,80,85"
			IF DIALOG
				pf$(1)="523567594608613611605594580564546527507487467"
				pf$(2)="531575602617622620613602588572554535515494474"
				pf$(3)="538583610625630629621610596579561542522501480"
				pf$(4)="544590618633638636629618603587568549528507486"
				pf$(5)="551597626641646644637625611594575555534513492"
				pf$(6)="557604633648653651644632618600581561540519497"
				pf$(7)="563611639655660658651639624607588567546525503"
				AT 3,5
				pf$(1)=MID$(pf$(tai%),((ag%*3)-2),3)
				PRINT "PEAK FLOW NORMAL=",pf$(1)
				PRINT "PATHOLOGIQUE < ",INT(0.8*VAL(pf$(1)))
				PRINT "GRAVE <",INT(0.6*VAL(pf$(1)))
				PRINT "D'aprŠs Gregg, Nunn AJ Br Med J, 1989"
			ELSE
				RETURN Debut:
			ENDIF
		ELSEIF sex%=2
			dINIT "PEAK FLOW FEMME"
			dCHOICE tai%,"TAILLE EN cm","155,160,165,170,175"
			dCHOICE ag%,"AGE","15,20,25,30,35,40,45,50,55,60,65,70,75,80,85"
			IF DIALOG
				pf$(1)="441463474478477472465456445433420407393379365"
				pf$(2)="446468480484483478471461450438425412398384370"
				pf$(3)="451573485489488483476466455443430416402388374"
				pf$(4)="456478490494493488481471460447434421406392378"
				pf$(5)="460483495499498493486476464452439425410396382"
				AT 3,5
				pf$(1)=MID$(pf$(tai%),((ag%*3)-2),3)
				PRINT "PEAK FLOW NORMAL=",pf$(1)
				PRINT "PATHOLOGIQUE <",INT(0.8*VAL(pf$(1)))
				PRINT "GRAVE <",INT(0.6*VAL(pf$(1)))
				PRINT "D'aprŠs Gregg, Nunn AJ Br Med J, 1989"
			ELSE
				RETURN Debut:
			ENDIF
		ELSEIF sex%=3
			dINIT "PEAK FLOW GAR‡ON"
			dCHOICE tai%,"TAILLE EN cm","100,105,110,115,120,125,130,135,140,145,150,155,160,165,170,175,180"
			IF DIALOG
				pf$(1)=MID$("106132159185212238265291318144170397423450476503529",(tai%*3)-2,3)
				AT 3,5
				PRINT "PEAK FLOW NORMAL =", pf$(1)
				PRINT "PATHOLOGIQUE <",INT(0.8*VAL(pf$(1)))
				PRINT "GRAVE <",INT(0.5*VAL(pf$(1)))
				PRINT "D'aprŠs GODFREY, Brit J Dis Chest,1970"
			ELSE
				RETURN Debut:
			ENDIF
		ELSEIF sex%=4
			dINIT "PEAK FLOW FILLE"
			dCHOICE tai%,"TAILLE EN cm","100,105,110,115,120,125,130,135,140,145,150,155,160,165,170,175,180"
			IF DIALOG
				pf$(1)=MID$("105132158185211237264290317343369396422449475501528",(tai%*3)-2,3)
				AT 3,5
				PRINT "PEAK FLOW NORMAL =", pf$(1)
				PRINT "PATHOLOGIQUE <",INT(0.8*VAL(pf$(1)))
				PRINT "GRAVE <",INT(0.5*VAL(pf$(1)))
				PRINT "D'aprŠs GODFREY, Brit J Dis Chest,1970"
			ELSE
				RETURN Debut:
			ENDIF
		ENDIF
	ELSE
		RETURN Debut:
	ENDIF
ENDP

PROC Pt:
	LOCAL son%,snd$(3,17),son$(17)
	snd$(1)="ROM::SYS$AL02.WVE"
	snd$(2)="ROM::SYS$AL03.WVE"
	snd$(3)="ROM::SYS$AL01.WVE"
	PRINT "Activez les fonctions sonores"
	DEB::
	dINIT "TEST AUDITIF B�B�"
	dTEXT "","CLOCHETTE",$400
	dTEXT "","CLOCHE",$400
	dTEXT "","FANFARE",$400
	dTEXT "","Esc pour quitter",2
	son%=DIALOG
	AT 10,5
	PRINT "Notez les r‚actions de l'enfant"
	IF son%<>0
		son%=son%-1
		son$=snd$(son%)
		Plays:(son$,0)
		CLS
		GOTO DEB::
	ELSE 
		RETURN Debut:
	ENDIF
ENDP

PROC Aide:
	LOCAL gate%,buf%(65),fname$(130)
	LOCAL page&,base&
	IF EXIST ("\APP\MEDIUTIL\mediuhlp.rsc")
		fname$="\APP\MEDIUTIL\mediuhlp.rsc"
	ELSEIF EXIST ("A:\APP\MEDIUTIL\mediuhlp.rsc")
		fname$="A:\APP\MEDIUTIL\mediuhlp.rsc"
	ELSEIF EXIST ("B:\APP\MEDIUTIL\mediuhlp.rsc")
		fname$="B:\APP\MEDIUTIL\mediuhlp.rsc"
	ELSE
		ALERT ("AIDE NON INSTALL�E","\APP\MEDIUTIL\MEDIUHLP.RSC EST N�CESSAIRE","CONTINUER")
		RETURN
	ENDIF
	base&=1
	page&=1
	POKE$ ADDR(buf%(1)),"#"+fname$
	gate%=PEEKW($38)
	SEND(gate%,27,buf%(2)) :
	SEND(gate%,26,#page&,#base&) :
ENDP

PROC Pi:
	dINIT "MEDIUTIL Version 1.3"
	dTEXT "","Ce programme est distribu‚ en Free Software"
	dTEXT "","Il est fourni volontairement avec ses sources"
	dTEXT "","Vous ˆtes encourag‚ … le redistribuer, et …"
	dTEXT "","l'am‚liorer … condition de distribuer les sources"
	dTEXT "","Pour me contacter :"
	dTEXT "","G.DELAFOND 350 rue Lecourbe 75015 PARIS"
	dTEXT "","tel (33) 0140600090_FAX (33) 0144260745"
	dTEXT "","delafond@club-internet.fr"
	DIALOG
	RETURN Debut:
ENDP

PROC Appkill:
	LOCAL ax%,bx%,cx%,dx%,si%,di%
	LOCAL ret%,flags%
	ax%=$0d00
	bx%=pid%
	flags%=OS(136,ADDR(ax%))
	IF (flags% AND 1)
		ret%=(ax% AND $ff)-256
	ELSE
		ret%=0
	ENDIF
ENDP