APCCONVT.m

APCCONVT ; [ 02/06/87  8:46 AM ]

 ;TJF/DPSC

 R !!,"ENTER PRINTER PORT, NULL =70 ",PR S:PR="" PR=70

 S BLKS="",CNTIN=0,CNTOUT=0,CNTERR=0,X="",Z=""

 F I=1:1:254 S BLKS=BLKS_" "

RGBL S GBL="" R !,"ENTER GLOBAL TO BE CONVERTED  ",GBL,!!

 Q:GBL=""

 S GBLPTT="^"_GBL I '$D(@GBLPTT) W !,"GLOBAL DOES NOT EXIST" G RGBL

 S GBLPT="^"_GBL_"(Z)"

 S Z=$O(@GBLPT) S INPUT=@GBLPT I INPUT["AP1" W !!,"HEADER RECORD MISSING" Q

 E  S FAC=$P(INPUT,"^",1),FACNAMR=$P(INPUT,"^",2)

 O 48:("EFU":200:200):3 E  U 0 W !,"TAPE UNIT 48 NOT ON-LINE, READY DEVICE" Q

 U 48 W *5

 S %ZA=$ZA,%ZA=%ZA\4#2 I %ZA=1 U 0 W !!,"TAPE NEEDS WRITE RING JOB ABORTED" Q

 O PR U PR W #,?20,"A P C  C O N V E R S I O N  E R R O R  L I S T"

READ S Z=$O(@GBLPT) G:Z="" EOJ S INPUT=@GBLPT

 S OUTPUT=""

 S CNTIN=CNTIN+1

 S I=0

 S OUTPUT=OUTPUT_$E(BLKS,1,$P($T(SCAN+1),";",2)-1)

LOOKUP S I=I+1 S X=$P(INPUT,"^",I+1) G:$P($T(SCAN+I),";",3)="END" EOD I $L(X)>$P($T(SCAN+I),";",3) W !,"PIECE  ",I+1," IS IN ERROR   ",X S CNTERR=CNTERR+1 G READ

 S OUTPUT=OUTPUT_$P(INPUT,"^",I+1)

 S OUTPUT=OUTPUT_$E(BLKS,1,$P($T(SCAN+I+1),";",2)-$L(OUTPUT)-1)

 G LOOKUP

EOD S CNTOUT=CNTOUT+1 S OUTPUT=OUTPUT_" "

 U 48 W OUTPUT U 0 W !,CNTOUT U PR

 G READ

EOJ ;END OF JOB PROCESSING

 W !,"RECORDS INPUT     ",CNTIN

 W !,"RECORDS OUTPUT    ",CNTOUT

 W !,"RECORDS REJECTED  ",CNTERR

 W #

 U 48 W *3 W *5 C PR C 48

 W !!,"END OF PROCESSING" Q

SCAN ;1ST FIELD IS POSITION IN OUTPUT RECORD 2ND IS INPUT FIELD LENGTH

 ;1;2;     RECORD TYPE

 ;3;6;     IHS FACILITY CODE

 ;9;6;     DATE OF VISIT (MMDDYY)

 ;15;1;    DAY OF WEEK (1-7)

 ;16;6;    IHS CHART NUMBER

 ;22;9;    SOCIAL SECURITY NUMBER (NUMERIC ONLY)

 ;31;6;    DATE OF BIRTH (MMDDYY)

 ;37;1;    SEX (1 OR 2)

 ;38;3;    TRIBE CODE

 ;41;3;    OPTIONAL FIELD #1

 ;44;7     COMMUNITY OF RESIDENCE

 ;51;1;    TIME OF DAY

 ;52;2;    TYPE OF CLINIC CODE

 ;54;8;    PROVIDERS OF SERVICE (PRIM. + 3)

 ;62;10;   IMMUNIZATIONS (CODES 1-0)

 ;72;1;    ALL IMMUNIZATIONS CURRENT

 ;73;1;    REGISTER UPDATE

 ;74;1;    T.B. REPORTING  SKIN TEST RESULTS

 ;75;1;    TB PURPOSE OF TEST

 ;76;1;    TB INH PROPHYLAXIS

 ;77;2;    TB NEXT APPOINTMENT (MO)

 ;79;1;    TB FIRST VISIT/REVISIT

 ;80;3;    TB DIAGNOSIS

 ;83;1;    MATERNAL HEALTH  MARTIAL STATUS

 ;84;2;    MH GRAVIDA

 ;86;2;    MH NUMBER OF LIVING CHILDREN

 ;88;1;    MH TRIMESTER OF FIRST VISIT

 ;89;1;    MH PRENATAL (DIAGNOSIS - FIRST/REVISIT)

 ;90;1;    FAMILY PLANNING  METHOD

 ;91;1;    FP STATUS

 ;92;2;    FP NEXT APPOINTMENT (MO)

 ;94;3;    FP UNUSED

 ;97;6;    FP PARENT FACILITY IHS UNIT NO.

 ;103;2;   ACCIDENTS  CAUSE

 ;105;2;   ACCIDENTS PLACE

 ;107;1;   ACCIDENTS  INJURY - ALCHOLOL RELATED

 ;108;6;   OPTIONAL FIELD #2

 ;114;4;   DX1  1ST BYTE IS 1ST V/RV CODE REMAINING 3 BYTES ARE DX

 ;118;4;   DX2 1ST BYTE IS 1ST V/RV CODE REMAINING 3 BYTES ARE DX

 ;122;11;  DIAGNOSTIC SERVICES (LAB + X-RAY)

 ;133;1;   SURGICAL PROCEDURE

 ;134;1;   DISPOSITION

 ;167;10;  SPECIFIC PROVIDERA CODES (5X2)

 ;177;4;   SURGICAL PROCEDURE CODE

 ;200;END; END OF TABLE