'|-----------------------------------------------| '|------------ Organ System Unknowns -----------| '|---- Copyright 1997 by Richard R. Lindquist ---| '|-----------------------------------------------| '|--------This is Current Ver 1.0 Build 42-------| '|-----S F I DONE--------------------------------| ' ' Assign these vars ' ssSelect$ = "GI" RNfile$ = "RNgi.dat" maxRN% = 150 maxF% = maxRN% + 1 maxRN$ = STR$(maxF%) maxRN$ = LTRIM$(maxRN$) MaxArray% = 101 ' ' Assigned Vars Done ' DIM ADx$(MaxArray%) ' ' Add Dx Array Here ' ' ADx$(1) = "Abscess " ADx$(2) = "Acute_Colitis " ADx$(3) = "Adenocarcinoma " ADx$(4) = "Adenoma " ADx$(5) = "Adenoma,_Papillary " ADx$(6) = "Adenoma,_Tubulovillous " ADx$(7) = "Adenomatous Polyp " ADx$(8) = "Anomaly " ADx$(9) = "Appendicitis " ADx$(10) = "Ascaris " ADx$(11) = "Atresia " ADx$(12) = "Barretts " ADx$(13) = "Bullet " ADx$(14) = "Candida " ADx$(15) = "Carcinoid " ADx$(16) = "Carcinoma " ADx$(17) = "Carcinoma,_NOS " ADx$(18) = "Cholecystitis,_Acute " ADx$(19) = "Cholecystitis,_Chronic " ADx$(20) = "Cholelithiasis " ADx$(21) = "Cholesterolosis " ADx$(22) = "Chronic_Passive_Congestion " ADx$(23) = "Cirrhosis " ADx$(24) = "Collagenous_Colitis " ADx$(25) = "Crohns " ADx$(26) = "Cryptosporidiosis " ADx$(27) = "Cyst " ADx$(28) = "Cystadenocarcinoma " ADx$(29) = "Cytomegalovirus " ADx$(30) = "Diverticulitis " ADx$(31) = "Diverticulosis " ADx$(32) = "Dysplasia, High Grade " ADx$(33) = "Dysplasia, Low Grade " ADx$(34) = "Erosion " ADx$(35) = "Fatty_Change " ADx$(36) = "Fibrosis " ADx$(37) = "Focal_Nodular_Hyperplasia " ADx$(38) = "Fungal_Esophagitis " ADx$(39) = "Gastrointestinal Stromal Tumor " ADx$(40) = "Gastroschisis " ADx$(41) = "GIST " ADx$(42) = "Gluten_Sensitive_Enteropathy " ADx$(43) = "Gunshot " ADx$(44) = "Helicobacter " ADx$(45) = "Hematoma " ADx$(46) = "Hemochromatosis " ADx$(47) = "Hemorrhage " ADx$(48) = "Hepatoblastoma " ADx$(49) = "Hepatocellular_Carcinoma " ADx$(50) = "Herpes " ADx$(51) = "Infarct " ADx$(52) = "Ischemic_Colitis " ADx$(53) = "Leiomyosarcoma " ADx$(54) = "Linitis_Plastica " ADx$(55) = "Liposarcoma " ADx$(56) = "Lymphoid Hyperplasia " ADx$(57) = "Lymphoma " ADx$(58) = "Metaplasia " ADx$(59) = "Metastatic_Adenocarcinoma " ADx$(60) = "Metastatic_Esophageal_Carcinoma " ADx$(61) = "Metastatic_Small_Cell_Carcinoma " ADx$(62) = "Mycobacterium " ADx$(63) = "Myeloma " ADx$(64) = "Necrosis " ADx$(65) = "Normal " ADx$(66) = "Normal Parotid Gland " ADx$(67) = "Normal Sublingual Gland " ADx$(68) = "Normal Submaxillary Gland " ADx$(69) = "Normal_Duodenum " ADx$(70) = "Normal_Ileum " ADx$(71) = "Normal_Jejunum " ADx$(72) = "Normal_Pylorus " ADx$(73) = "Normal_Tonsil " ADx$(74) = "Omphalocoele " ADx$(75) = "Pancreatitis " ADx$(76) = "Papillary_Adenocarcinoma " ADx$(77) = "Perforation " ADx$(78) = "Peritonitis " ADx$(79) = "Pleomorphic Adenoma " ADx$(80) = "Pneumatosis " ADx$(81) = "Polyp " ADx$(82) = "Polyposis " ADx$(83) = "Pseudocyst " ADx$(84) = "Pseudomembranous_Colitis " ADx$(85) = "Pyostomatitis_Vegetans " ADx$(86) = "Reflux " ADx$(87) = "Repair " ADx$(88) = "Serous_Cystadenoma " ADx$(89) = "Sjogrens Disease " ADx$(90) = "Squamous Carcinoma " ADx$(91) = "Squamous_Cell_Carcinoma " ADx$(92) = "Squamous_Cell_Carcinoma_in_situ " ADx$(93) = "Stricture " ADx$(94) = "Stromal " ADx$(95) = "Thrombus " ADx$(96) = "Tongue,_Squamous_Carcinoma " ADx$(97) = "Toxic_Megacolon " ADx$(98) = "Ulcer " ADx$(99) = "Ulcerative_Colitis " ADx$(100) = "Varices " ' HTLM variables ' ' comma is CHR$(44) ' / is (47) ' = is (61) ' quote is (34) ' single quote is (39) ' imageurl$ = "ImageURL" system$ = "System" ' ' Image Source ' 'pathweb$ = "http://155.37.1.60/Images/" pathweb$ = "/eAtlas/Images/" html$ = "" htmlEnd$ = "" title$ = "" titleEnd$ = "" body$ = "" bodyEnd$ = "" Href$ = "" imageheight$ = "230" imagewidth$ = "290" imgsrc1$ = " "z" THEN caserec$ = "zzz" 'DO SELECT CASE LEFT$(caserec$, 3) CASE IS = "zx1" ' PRINT "1"; rec$ x = LEN(rec$) x = x - 3 uid$ = MID$(rec$, 4, x) PRINT "Working on uid# "; uid$ ' uid$ = RIGHT$(rec$, 4) 'uid$ = rec$ GOTO 10 'Need to read in all fields before wrinting file CASE IS = "zx2" 'PRINT "2"; rec$ x = LEN(rec$) x = x - 3 ss$ = MID$(rec$, 4, x) 'ss$ = rec$ GOTO 10 CASE IS = "zx3" 'PRINT "3"; rec$ x = LEN(rec$) x = x - 3 url$ = MID$(rec$, 4, x) 'url$ = RIGHT$(rec$, 4) 'url$ = rec$ GOTO 10 CASE IS = "zx4" 'PRINT "4"; rec$ x = LEN(rec$) x = x - 3 organ$ = MID$(rec$, 4, x) 'Organ$ = RIGHT$(rec$, 4) 'Organ$ = rec$ GOTO 10 CASE IS = "zx5" 'PRINT "5"; rec$ x = LEN(rec$) x = x - 3 ic$ = MID$(rec$, 4, x) 'IC$ = RIGHT$(rec$, 4) 'IC$ = rec$ GOTO 10 CASE IS = "zx6" 'PRINT "6"; rec$ x = LEN(rec$) x = x - 3 sd$ = MID$(rec$, 4, x) 'SD$ = RIGHT$(rec$, 4) 'sd$ = rec$ GOTO 10 CASE IS = "zx7" 'PRINT "6"; rec$ x = LEN(rec$) x = x - 3 process$ = MID$(rec$, 4, x) 'SD$ = RIGHT$(rec$, 4) 'sd$ = rec$ GOTO 10 CASE IS = "zx8" 'PRINT "6"; rec$ x = LEN(rec$) x = x - 3 tcode$ = MID$(rec$, 4, x) 'CLS 'PRINT "before: "; tcode$ tcode$ = RTRIM$(tcode$) tcode$ = LTRIM$(tcode$) tcode$ = MID$(tcode$, 2, 3) GOTO 10 CASE IS = "zx9" 'PRINT "6"; rec$ x = LEN(rec$) x = x - 3 mcode$ = MID$(rec$, 4, x) 'PRINT "before: "; mcode$ mcode$ = RTRIM$(mcode$) mcode$ = LTRIM$(mcode$) mcode$ = MID$(mcode$, 2, 5) 'PRINT tcode$ 'PRINT mcode$ 'INPUT o$ GOTO 10 CASE IS = "zx0" 'PRINT "6"; rec$ x = LEN(rec$) x = x - 3 gorm$ = MID$(rec$, 4, x) 'SD$ = RIGHT$(rec$, 4) 'sd$ = rec$ GOTO 10 CASE IS = "zy1" 'PRINT "6"; rec$ x = LEN(rec$) x = x - 3 iby$ = MID$(rec$, 4, x) 'SD$ = RIGHT$(rec$, 4) 'sd$ = rec$ IF LEN(rec$) < 4 THEN iby$ = " " GOTO 10 CASE IS = "zy2" 'PRINT "6"; rec$ x = LEN(rec$) x = x - 3 ibyh$ = MID$(rec$, 4, x) 'SD$ = RIGHT$(rec$, 4) 'sd$ = rec$ GOTO 10 'LOOP UNTIL rec$ = "zzz" CASE IS = "zzz" ' zzz is sentinal for Long Image Description DIM LongD$(125) ' set up string array for all the lines in Long D LongD$(0) = rec$ PRINT LongD$(0) u = 0 DO UNTIL rec$ = "|" 'keep reading Long D lines until end of field | LINE INPUT #1, rec$ IF LEN(rec$) > 1 THEN ' Do not process blank lines or | line u = u + 1 LongD$(u) = rec$ ' PRINT u, LongD$(u) ' screen out to see progress END IF LOOP 'INPUT k$ END SELECT ' ' All Vars Set ' Ready to Write *.htm file ' ' ' Clean out leading & trailing blanks ' uid$ = RTRIM$(uid$) uid$ = LTRIM$(uid$) url$ = RTRIM$(url$) organ$ = RTRIM$(organ$) sd$ = RTRIM$(sd$) ss$ = RTRIM$(ss$) ic$ = RTRIM$(ic$) url$ = LTRIM$(url$) organ$ = LTRIM$(organ$) sd$ = LTRIM$(sd$) ss$ = LTRIM$(ss$) ic$ = LTRIM$(ic$) tcode$ = LTRIM$(tcode$) mcode$ = LTRIM$(mcode$) gorm$ = LTRIM$(gorm$) iby$ = LTRIM$(iby$) ibyh$ = LTRIM$(ibyh$) tcode$ = RTRIM$(tcode$) mcode$ = RTRIM$(mcode$) gorm$ = RTRIM$(gorm$) iby$ = RTRIM$(iby$) ibyh$ = RTRIM$(ibyh$) ' ' Sreen Out for debugging ' 'PRINT "Uid="; uid$ 'PRINT "Url="; url$ 'PRINT "Organ="; organ$ 'PRINT "SD="; sd$ 'PRINT "Ss="; ss$ 'PRINT "ic="; ic$ 'PRINT "Process = "; process$ 'PRINT "Tcode= "; tcode$ 'PRINT "Mcode= "; mcode$ 'PRINT "GorM = "; gorm$ 'PRINT "By = "; iby$ 'PRINT "Hosp= "; ibyh$ 'PRINT "LongD="; longd$ ' ' Name the generated html page by uid ss$ = LTRIM$(ss$) ss$ = RTRIM$(ss$) Lss% = LEN(ss$) IF Lss% < 1 THEN GOTO 888 IF ss$ <> ssSelect$ GOTO 999 ' ' ' ' Assign Variables for Comments & Metas ' cr1$ = "" cr2$ = "" cr3$ = "" cr4$ = "" cr5$ = "" cr6$ = "" cr7$ = "" cr8$ = "" cr9$ = "" cr10$ = "" cr11$ = "" cr12$ = "" meta$ = "Pick Answer" FOR DxA% = 1 TO MaxArray% IF RTRIM$(ADx$(DxA%)) = sd$ THEN PRINT #4, "" + ADx$(DxA%) + "
" ELSE PRINT #4, "" + ADx$(DxA%) + "
" END IF NEXT DxA% PRINT #4, "" CLOSE #4 ' 'End Dx Array End Dx Array ' fileout$ = quote$ + "S\S" + uid$ + ".htm" + quote$ Ifileout$ = quote$ + "I\I" + uid$ + ".htm" + quote$ Nfileout$ = quote$ + "N\N" + uid$ + ".htm" + quote$ Yfileout$ = quote$ + "Y\Y" + uid$ + ".htm" + quote$ Wfileout$ = quote$ + "W\W" + uid$ + ".htm" + quote$ imgsrc$ = "
" + organ$ + "" PRINT #5, "[©]" PRINT #5, "Help" PRINT #5, "Show Answer" PRINT #5, " << " PRINT #5, " < " PRINT #5, " > " PRINT #5, " >> " PRINT #5, "Home" PRINT #5, "
" CLOSE #5 ' ' Wrinting N File Out ' OPEN Nfileout$ FOR OUTPUT AS #5 PRINT "Writing N File" PRINT #5, "
" PRINT #5, "
Wrong " PRINT #5, "Help" PRINT #5, "Show Answer" PRINT #5, " << " PRINT #5, " < " PRINT #5, " > " PRINT #5, " >> " PRINT #5, "Home" PRINT #5, "
" CLOSE #5 ' ' Yes File Write Out ' 'Wrong 'Correct OPEN Yfileout$ FOR OUTPUT AS #5 PRINT "Writing Y File" PRINT #5, "
" PRINT #5, "
Correct!" PRINT #5, "Help" PRINT #5, "Show Answer" PRINT #5, " << " PRINT #5, " < " PRINT #5, " > " PRINT #5, " >> " PRINT #5, "Home" PRINT #5, "
" CLOSE #5 ' ' F File Write Out ' ' 'CLS OPEN frameF$ FOR OUTPUT AS #3 PRINT "Writing F File" ' ' Write out Comments & Metas ' PRINT #3, cr1$ PRINT #3, cr2$ PRINT #3, cr3$ PRINT #3, cr4$ PRINT #3, cr5$ PRINT #3, cr6$ PRINT #3, cr7$ PRINT #3, cr8$ PRINT #3, cr9$ PRINT #3, cr10$ PRINT #3, cr11$ PRINT #3, cr12$ PRINT #3, PRINT #3, head$ PRINT #3, metad3$ + metad4$ PRINT #3, meta$ + metaE$ PRINT #3, metaSite$ + metaE$ ' 'Title ' PRINT #3, title$; "eAtlas Unknown Quiz"; titleEnd$ PRINT #3, "" PRINT #3, "" PRINT #3, "" PRINT #3, "" PRINT #3, "" PRINT #3, "" PRINT #3, "" PRINT #3, "" PRINT #3, "" CLOSE #3 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& ' 'Opening Individual HTML Files and Writing code ' 'OPEN "JUNK.jnk" FOR OUTPUT AS #2 'PRINT fileout$ 'INPUT o$ ' ' This is SHOW ME Screen ' OPEN fileout$ FOR OUTPUT AS #2 PRINT "Writing S File" OPEN Ifileout$ FOR OUTPUT AS #4 ' 'Start writing html page ' PRINT #2, html$ ' ' Translate pathological process for meta key words ' process$ = LTRIM$(process$) process$ = RTRIM$(process$) 'PRINT "Process is "; process$ ' sreen out for debugging IF process$ = "Con" THEN pro$ = "Congenital Abnormalities" IF process$ = "Trauma" THEN pro$ = "Trauma" IF process$ = "Normal" THEN pro$ = "Normal" IF process$ = "Benign" THEN pro$ = "Benign Tumor" IF process$ = "Malign" THEN pro$ = "Malignant Tumor" IF process$ = "Inf" THEN pro$ = "Inflammation & Fibrosis" IF process$ = "Degen" THEN pro$ = "Necrosis & Degeneration" IF process$ = "Growth" THEN pro$ = "Growth Abnormalities" IF process$ = "Vasc" THEN pro$ = "Vascular Abnormalities" IF process$ = "Mech" THEN pro$ = "Mechanical Abnormalities" 'PRINT "Pro is "; pro$ 'screen out for debugging ' ' Write out Comments & Metas ' PRINT #2, cr1$ PRINT #2, cr2$ PRINT #2, cr3$ PRINT #2, cr4$ PRINT #2, cr5$ PRINT #2, cr6$ PRINT #2, cr7$ PRINT #2, cr8$ PRINT #2, cr9$ PRINT #2, cr10$ PRINT #2, cr11$ PRINT #2, cr12$ PRINT #2, PRINT #2, head$ PRINT #2, metad1$ + metad2$ PRINT #2, meta$ + metaE$ PRINT #2, metaSite$ + metaE$ ' 'Title ' PRINT #2, title$; sd$; " of the "; organ$; quote$; titleEnd$ PRINT #2, "" PRINT #2, body$ ' ' Nav Bar Generation ' 'PRINT #2, "" 'PRINT #2, "
" 'PRINT #2, "" 'PRINT #2, "
[Search Frames]" 'PRINT #2, "[Search No frames]" 'PRINT #2, "[PathWeb Home]" 'PRINT #2, "[©]" 'PRINT #2, "[Feed Back]" 'PRINT #2, "[About]" 'PRINT #2, "[" + tcode$ + mcode$ + "]" 'PRINT #2, "
" 'PRINT #2, "
" 'PRINT #2, "" ' ' Nav Bar Done ' '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ ' ' Nav Bar Above is Finished ' PRINT #2, "
" PRINT #2, "" PRINT #2, "" PRINT #2, "" PRINT #2, "" PRINT #2, "
" ' 'Copy from ' PRINT #2, "" + imgsrc$ + "" PRINT #4, "
" PRINT #4, "" PRINT #2, "
" PRINT #2, "" PRINT #2, "
" + sd$ + ", " + organ$ + "" PRINT #2, "
" + ic$ PRINT #2, "
" ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' '' ' Write out Long Description ' IF LEN(LongD$(0)) > 1 THEN PRINT #2, LongD$(0) 'PRINT LongD$(0) END IF IF u > 0 THEN w = u u = 0 FOR I = 1 TO w u = u + 1 Flet$ = LEFT$(LongD$(u), 1) 'PRINT Flet$; "------>"; ASC(Flet$) IF ASC(Flet$) = 149 THEN LongD$(u) = "
" + LongD$(u) IF LongD$(u) <> "|" THEN PRINT #2, LongD$(u) ' IF LongD$(u) <> "|" THEN PRINT "Writing Now "; LongD$(u) NEXT I ' INPUT o$ 'CLS END IF ' ' End writing out long description ' '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' PRINT #2, "
Contrib. by:" + iby$ + " " + ibyh$ PRINT #2, "
" PRINT #2, "" PRINT #2, "" PRINT #2, "" PRINT #2, "
Etiology, Pathogenesis, Clinical, and More Info " PRINT #2, "
" PRINT #2, "
" PRINT #2, "" PRINT #2, "" '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ CLOSE #2 CLOSE #4 PRINT "One HTML File Generation Completed" PRINT "|" PRINT "\" 888 PRINT "Looping" LOOP UNTIL EOF(1) CLOSE #1 END 999 PRINT "Skip not "; ssSelect$ GOTO 888 END