tldm-universe/CMS/BP.CNV/REL8.CONV.PM
2024-09-10 15:25:06 -04:00

63 lines
1.7 KiB
Raku
Executable File

* TDJ.CONVERT.DEMOGS
* PURPOSE : TO CONVERT PM DEMOGRAPHIC ATTRIBUTES FROM R8.0 TO R8.5
* DATE : 8/13/93
* AUTHOR : KJC
* MODIFIED : SPA : CONVERTED DEMOGRAPHICS ATTRIBUTES TO SINGLE ATTR
* : REMOVED R7-SPECIFIC CONVERSIONS
*-- opens and includes --
$INCLUDE BP.MASTER GEN.COM2
$INCLUDE BP.MASTER PM
OPEN "PM" TO PM ELSE ABORT 201,"PM"
CRT CS
CRT @(0,0):RV:"TDJ.CONVERT.DEMOGS CONVERT PM DEMOGRAPHIC ATTRIBUTES TO RELEASE 8.5 FORMAT":ERV
*-- initialize variables --
EOF=0 ; CNT=0 ; WRT=0
*-- main loop --
EXECUTE \GET-LIST PM.WITH.DEMOGS\
LOOP
READNEXT ID ELSE EOF=1
UNTIL EOF DO
IF REM(CNT,100) ELSE GOSUB 1000
READ PMREC FROM PM,ID THEN
CNT=CNT+1
ATT.NUM=0
*-- misc stuff --
IF PMREC<50>='' THEN
MTITLE="1":VM:"01":VM:"8":VM:"08":VM:"10":VM:"53"
FTITLE="2":VM:"02":VM:"3":VM:"03":VM:"4":VM:"04":VM:"9":VM:"09":VM:"49":VM:"58":VM:"55":VM:"56"
LOCATE(PMREC<1>,MTITLE,1;FND) THEN
PMREC<50>="M"
END ELSE
LOCATE(PMREC<1>,FTITLE,1;FND) THEN
PMREC<50>="F"
END
END
END
DEMOG=PMREC<45>:VM:PMREC<46>:VM:PMREC<43>:VM:PMREC<44>:VM:VM:PMREC<50>:VM:VM:PMREC<48>:VM:PMREC<47>:VM:PMREC<51>:VM:PMREC<56>
PMREC<43>=DEMOG ;*-- set demographics as single attribute
PMREC<44>='' ;*-- clear R7 demographics attributes
PMREC<45>=''
PMREC<46>=''
PMREC<47>=''
PMREC<48>=''
PMREC<49>=''
PMREC<50>=''
PMREC<51>=''
PMREC<52>=''
PMREC<53>=''
PMREC<54>=''
PMREC<55>=''
PMREC<56>=''
PMREC<57>=''
WRITE PMREC ON PM,ID
WRT=WRT+1
END
REPEAT
GOSUB 1000
STOP
****
1000 *
CRT @(5,5):"TOTAL RECORDS PROCESSED :":CNT
CRT @(5,7):"TOTAL RECORDS CONVERTED :":WRT
RETURN