AUTPOS1 ; IHS/DIRM/JDM/DFM - POST INIT; [ 03/04/98 8:10 AM ]
;;98.1;IHS DICTIONARIES (POINTERS);;MAR 04, 1998;Build 6
;
;
UPDATE ;EP - update fields in AUT dictionaries
D ^XBKVAR
I DUZ(0)'="@" W !!,"SORRY, YOU MUST HAVE PROGRAMMER ACCESS (Variable DUZ(0) must = '@'.)",!,"POST INITS NOT RUN - PLEASE DO SO LATER BY RUNNING RTN '^AUTPOS1' (D ^AUTPOS1)." Q
W !!,"Many AUT tables will now be updated. This will take a while.",!
W !,"Please have your aux port printer turned ON. THANKS."
S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="Y" K DA D ^DIR K DIR
Q:$D(DIRUT)
I 'Y W !!,"BYE - POST INIT NOT RUN - PLEASE RUN IT LATER BY RUNNING ^AUTPOS1." Q
D MEAS
D MEASTYPE
D RCAT
D RECODE^AUTPOS2 ;update recode apc/icd file
D RECINJ ; update recode injury file
D REINDEX1 ;reindex AD on 9999999.08 and C on 9999999.12
D IMM ;update immunization entries with CPT codes
D EXAM ;update exam table
D SKINTEST
D HF
D PPT ;do presentation types
D EOJ
Q
EOJ ;
K AUTCPT,AUTJ,AUTMOD,AUTT,AUTTXT,AUTVAL,AUTX,AUTY
K DIC,DD,DLAYGO,DR,DLAYGO,X,Y,D,DIU
D ^XBFMK
W !!,"All done with AUTT post init.",!
Q
REINDEX1 ;
W !,"Re-indexing a new index on RECODE INJURY"
S DIK="^AUTTINJ(",DIK(1)=".04^C" D ENALL^DIK
W !,"Re-indexing a new index on RECODE APC/ICD"
S DIK="^AUTTRCD(",DIK(1)=".06^AC" D ENALL^DIK
Q
IMM ;add cpt codes to immunization entries
W !,"Adding CPT codes to immunization table."
S AUTT="IMMCPT" F AUTJ=1:1 S AUTX=$T(@AUTT+AUTJ),AUTVAL=$P(AUTX,";;",2) Q:AUTVAL="QUIT"!(AUTVAL="") D
.S AUTY=0 F S AUTY=$O(^AUTTIMM("C",AUTVAL,AUTY)) Q:AUTY'=+AUTY D
..S DA=AUTY,DIE="^AUTTIMM(",DR=".11///"_$P(AUTX,";;",3) D ^DIE I $D(Y) W !,"updating immunization ",AUTVAL,"failed. Notify database mgr. of incomplete Immunization file.."
..Q
.Q
Q
MEAS ;add cpt code to tonometry measurement type
W !,"Adding CPT code to measurement types."
S DA=$O(^AUTTMSR("B","TON",0)) I 'DA W !,"Could not find Tonometry measurement type. Skipping Tonometry Measurement update." Q
S DIE="^AUTTMSR(",DR=".11///92100" D ^DIE I $D(Y) W !,"Could not enter CPT code in tonometry file. Notify database mgr." Q
Q
MEASTYPE ;
W !,"Adding Measurement Types (Edema and Presentation)",!
S X="ED",DIC="^AUTTMSR(",DIC(0)="L",DLAYGO=9999999.07,DIC("DR")=".02////EDEMA;.03////55" D ^DIC K DIC,DD,DLAYGO,DA,D0
S X="PR",DIC="^AUTTMSR(",DIC(0)="L",DLAYGO=9999999.07,DIC("DR")=".02////PRESENTATION;.03////56" D ^DIC K DIC,DD,DLAYGO,DA,D0
S DA=$O(^AUTTMSR("B","EFF",0)) I DA S DIE="^AUTTMSR(",DR=".01///EF" D ^DIE
S DA=$O(^AUTTMSR("B","STN",0)) I DA S DIE="^AUTTMSR(",DR=".01///SN" D ^DIE
S X="CXD",DIC="^AUTTMSR(",DIC(0)="L",DLAYGO=9999999.07,DIC("DR")=".02////CERVIX DILATATION;.03////57" D ^DIC K DIC,DD,DLAYGO,DA,D0
S X="EF",DIC="^AUTTMSR(",DIC(0)="L",DLAYGO=9999999.07,DIC("DR")=".02////EFACEMENT;.03////58" D ^DIC K DIC,DD,DLAYGO,DA,D0
S X="SN",DIC="^AUTTMSR(",DIC(0)="L",DLAYGO=9999999.07,DIC("DR")=".02////STATION (PREGNANCY);.03////59" D ^DIC K DIC,DD,DLAYGO,DA,D0
Q
HF ;
W !,"Adding a few new health factors"
;add current smoker & smokeless
;exposure to environmental tobacco smoke
;smoker in home
S X="CURRENT SMOKER & SMOKELESS",DIC="^AUTTHF(",DIC(0)="L",DLAYGO=9999999.64 D ^DIC K DIC,DD,DLAYGO,DA,D0
S X="EXPOSURE TO ENVIRONMENTAL TOBACCO SMOKE",DIC="^AUTTHF(",DIC(0)="L",DLAYGO=9999999.64 D ^DIC K DIC,DD,DLAYGO,DA,D0
S X="SMOKER IN HOME",DIC="^AUTTHF(",DIC(0)="L",DLAYGO=9999999.64 D ^DIC K DIC,DD,DLAYGO,DA,D0
Q
SKINTEST ;
W !,"Adding CPT code to skin test entries."
S AUTT="SKCPT" F AUTJ=1:1 S AUTX=$T(@AUTT+AUTJ),AUTVAL=$P(AUTX,";;",2) Q:AUTVAL="QUIT"!(AUTVAL="") D
.S AUTY=0 F S AUTY=$O(^AUTTSK("C",AUTVAL,AUTY)) Q:AUTY'=+AUTY D
..S DA=AUTY,DIE="^AUTTSK(",DR=".11///"_$P(AUTX,";;",3) D ^DIE I $D(Y) W !,"updating skin test code ",AUTVAL,"failed. Notify database mgr. of incomplete SKIN TEST file."
..Q
.Q
Q
EXAM ;
W !,"Adding CPT code to exam entries."
S AUTT="EXAMCPT" F AUTJ=1:1 S AUTX=$T(@AUTT+AUTJ),AUTVAL=$P(AUTX,";;",2) Q:AUTVAL="QUIT"!(AUTVAL="") D
.S AUTY=0 F S AUTY=$O(^AUTTEXAM("C",AUTVAL,AUTY)) Q:AUTY'=+AUTY D
..S DA=AUTY,DIE="^AUTTEXAM(",DR=".11///"_$P(AUTX,";;",3) D ^DIE I $D(Y) W !,"Updating exam ",AUTVAL,"failed. Notify database mgr. of incomplete EXAM file."
..Q
.Q
Q
RCAT ;update recode category 9999999.081, field .01
W !,"Adding APC Recode Categories to Recode Category File.."
S DIC="^AUTTRCDC(",DIC(0)="L"
S AUTT="RCDC" F AUTJ=1:1 S AUTX=$T(@AUTT+AUTJ),AUTVAL=$P(AUTX,";;",2) Q:AUTVAL="QUIT"!(AUTVAL="") D
.S X=AUTVAL D ^DIC I Y=-1 W "ADDING of Category ",AUTVAL," failed.. skipping. Notify Database Manager."
.Q
K DIC,DD,DLAYGO,DA,DR
Q
RECINJ ;update .02 and .04 of RECODE INJURY FILE
W !,"Adding Narrative and E-Codes to APC Injury code table..."
S AUTT="INJ02" F AUTJ=1:1 S AUTX=$T(@AUTT+AUTJ),AUTVAL=$P(AUTX,";;",2) Q:AUTVAL="QUIT"!(AUTVAL="") D
.S AUTCAT=$P(AUTX,";;",4)
.S AUTICD=$P(AUTX,";;",3),AUTICD=$O(^ICD9("AB",AUTICD,0))
.I AUTICD="" W !!,"Can't find ICD code ",$P(AUTX,";;",3)," for APC code ",AUTVAL
.S AUTICD="`"_AUTICD
.S DA=$O(^AUTTRIJ("B",AUTVAL,0)) I DA="" W !,"Can't find entry ",AUTVAL," to edit.",! Q
.S DIE="^AUTTRIJ(",DR=".04///"_AUTCAT_";.02///"_AUTICD
.D ^DIE I $D(Y) W !,"Editing APC INJURY Code ",AUTVAL," failed, notify database mgr. of incomplete RECODE INJURY file."
.Q
Q
PPT ;EP - add presentation types to presentation type file
W !,"Adding Pregnancy Presentation Types to Presentation Type file..."
S DIC="^AUTTPPT(",DIC(0)="L"
S AUTT="PPTTYPE" F AUTJ=1:1 S AUTX=$T(@AUTT+AUTJ),AUTVAL=$P(AUTX,";;",2) Q:AUTVAL="QUIT"!(AUTVAL="") D
.S X=AUTVAL,DIC("DR")=".02////"_$P(AUTX,";;",3)_";.03////"_$P(AUTX,";;",4),DLAYGO=9999999.87 D ^DIC K DA I Y=-1 W !,"Adding Presentation Type ",X," failed. Notify database mgr. of incomplete PRESENTATION TYPE file.",!
.Q
K DIC,DD,DLAYGO,DR,DA,DD
Q
EOJ2 ;
K AUTX,AUTVAL,AUTICD,AUTCAT
Q
PPTTYPE ; presentation types
;;VERTEX;;1;;VT
;;COMPLETE BREECH;;2;;CB
;;DOUBLE FOOTLING;;3;;DF
;;SINGLE FOOTLING;;4;;SF
;;FRANK BREECH;;5;;FB
;;FACE;;6;;FA
;;UNSPECIFIED BREECH;;7;;UB
;;TRANSVERSE;;8;;TR
;;OTHER;;9;;OT
;;UNKNOWN;;U;;UNK
;;QUIT
RCDC ;
;;INFECTIVE & PARASITIC DIS.
;;NEOPLASMS
;;ENDOCR., NUTR., & METAB. DIS.
;;DIS. OF BLOOD & BLOOD-FORMING ORGANS
;;MENTAL DISORDERS
;;DIS. OF NERVOUS SYSTEM
;;EYE DISEASES
;;EAR DISEASES
;;DIS. OF CIRCULATORY SYSTEM
;;DIS. OF RESPIRATORY SYSTEM
;;DIS. OF DIGESTIVE SYSTEM
;;DIS. OF URINARY TRACT
;;DIS. OF FEMALE GENITALIA & BREAST
;;PREG., CHILDBIRTH & THE PUERPERIUM
;;DIS. OF SKIN & SUBCUTANEOUS TISSUE
;;MUSCULOSKEL SYSTEM & CONNECT. TISSUE
;;CONGENITAL ANOMALIES
;;SYMPTOMS & ILL-DEFINED CONDITION
;;SUPPLEMENTAL
;;ACCID. POISONINGS AND VIOLENCE
;;ALL DIS., MALE GENIT. (EXCL VD)
;;CAUSES OF PERNATAL MORB. & MORT.
;;QUIT
INJ02 ;
;;01;;E819.9;;MOTOR VEHICLE ACCIDENT
;;03;;E838.9;;WATER TRANSPORT
;;04;;E844.9;;AIR TRANSPORT
;;05;;E866.9;;ACCIDENTAL POISONING
;;06;;E888.;;ACCIDENTAL FALLS
;;07;;E899.;;FIRES AND FLAMES
;;08;;E904.9;;ENVIRONMENTAL FACTORS
;;09;;E905.9;;STINGS AND VENOMS
;;10;;E906.9;;ANIMAL RELATED, INCLUDING BITES
;;11;;E910.9;;DROWNING AND SUBMERSION
;;12;;E920.9;;CUTTING AND PIERCING OBJECTS
;;13;;E922.9;;FIREARMS ACCIDENTS
;;14;;E919.9;;MACHINERY
;;15;;E958.9;;SUICIDE ATTEMPT
;;16;;E968.9;;INJ. PURPOSELY INFLICTED BY OTHERS
;;17;;E967.9;;BATTERED CHILD
;;18;;E988.9;;UNDETERMINED CAUSE
;;19;;E988.8;;OTHER CAUSES
;;QUIT
IMMCPT ;
;;01;;
;;02;;90718
;;03;;90701
;;04;;90703
;;05;;90714
;;06;;90712
;;07;;90713
;;08;;
;;09;;
;;10;;
;;11;;90705
;;12;;90724
;;13;;90725
;;14;;90706
;;15;;90704
;;16;;90728
;;17;;90707
;;18;;90708
;;19;;90732
;;31;;90717
;;32;;
;;33;;90726
;;34;;90702
;;35;;90737
;;37;;90737
;;38;;90737
;;39;;90737
;;40;;90730
;;41;;90716
;;42;;90700
;;QUIT
EXAMCPT ;;
;;01;;
;;02;;
;;03;;
;;04;;
;;05;;
;;06;;
;;07;;
;;08;;
;;09;;
;;10;;
;;11;;
;;12;;
;;14;;
;;15;;57410
;;16;;
;;17;;92506
;;18;;
;;19;;92081
;;20;;
;;21;;92502
;;22;;
;;23;;92551
;;24;;92552
;;25;;92567
;;26;;92100
;;27;;
;;28;;
;;29;;
;;QUIT
SKCPT ;
;;23;;86490
;;24;;86585
;;21;;86580
;;22;;
;;20;;86585
;;QUIT
AUTPOS1 ; IHS/DIRM/JDM/DFM - POST INIT; [ 03/04/98 8:10 AM ]
+1 ;;98.1;IHS DICTIONARIES (POINTERS);;MAR 04, 1998;Build 6
+2 ;
+3 ;
UPDATE ;EP - update fields in AUT dictionaries
+1 DO ^XBKVAR
+2 IF DUZ(0)'="@"
WRITE !!,"SORRY, YOU MUST HAVE PROGRAMMER ACCESS (Variable DUZ(0) must = '@'.)",!,"POST INITS NOT RUN - PLEASE DO SO LATER BY RUNNING RTN '^AUTPOS1' (D ^AUTPOS1)."
QUIT
+3 WRITE !!,"Many AUT tables will now be updated. This will take a while.",!
+4 WRITE !,"Please have your aux port printer turned ON. THANKS."
+5 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+6 IF $DATA(DIRUT)
QUIT
+7 IF 'Y
WRITE !!,"BYE - POST INIT NOT RUN - PLEASE RUN IT LATER BY RUNNING ^AUTPOS1."
QUIT
+8 DO MEAS
+9 DO MEASTYPE
+10 DO RCAT
+11 ;update recode apc/icd file
DO RECODE^AUTPOS2
+12 ; update recode injury file
DO RECINJ
+13 ;reindex AD on 9999999.08 and C on 9999999.12
DO REINDEX1
+14 ;update immunization entries with CPT codes
DO IMM
+15 ;update exam table
DO EXAM
+16 DO SKINTEST
+17 DO HF
+18 ;do presentation types
DO PPT
+19 DO EOJ
+20 QUIT
EOJ ;
+1 KILL AUTCPT,AUTJ,AUTMOD,AUTT,AUTTXT,AUTVAL,AUTX,AUTY
+2 KILL DIC,DD,DLAYGO,DR,DLAYGO,X,Y,D,DIU
+3 DO ^XBFMK
+4 WRITE !!,"All done with AUTT post init.",!
+5 QUIT
REINDEX1 ;
+1 WRITE !,"Re-indexing a new index on RECODE INJURY"
+2 SET DIK="^AUTTINJ("
SET DIK(1)=".04^C"
DO ENALL^DIK
+3 WRITE !,"Re-indexing a new index on RECODE APC/ICD"
+4 SET DIK="^AUTTRCD("
SET DIK(1)=".06^AC"
DO ENALL^DIK
+5 QUIT
IMM ;add cpt codes to immunization entries
+1 WRITE !,"Adding CPT codes to immunization table."
+2 SET AUTT="IMMCPT"
FOR AUTJ=1:1
SET AUTX=$TEXT(@AUTT+AUTJ)
SET AUTVAL=$PIECE(AUTX,";;",2)
IF AUTVAL="QUIT"!(AUTVAL="")
QUIT
Begin DoDot:1
+3 SET AUTY=0
FOR
SET AUTY=$ORDER(^AUTTIMM("C",AUTVAL,AUTY))
IF AUTY'=+AUTY
QUIT
Begin DoDot:2
+4 SET DA=AUTY
SET DIE="^AUTTIMM("
SET DR=".11///"_$PIECE(AUTX,";;",3)
DO ^DIE
IF $DATA(Y)
WRITE !,"updating immunization ",AUTVAL,"failed. Notify database mgr. of incomplete Immunization file.."
+5 QUIT
End DoDot:2
+6 QUIT
End DoDot:1
+7 QUIT
MEAS ;add cpt code to tonometry measurement type
+1 WRITE !,"Adding CPT code to measurement types."
+2 SET DA=$ORDER(^AUTTMSR("B","TON",0))
IF 'DA
WRITE !,"Could not find Tonometry measurement type. Skipping Tonometry Measurement update."
QUIT
+3 SET DIE="^AUTTMSR("
SET DR=".11///92100"
DO ^DIE
IF $DATA(Y)
WRITE !,"Could not enter CPT code in tonometry file. Notify database mgr."
QUIT
+4 QUIT
MEASTYPE ;
+1 WRITE !,"Adding Measurement Types (Edema and Presentation)",!
+2 SET X="ED"
SET DIC="^AUTTMSR("
SET DIC(0)="L"
SET DLAYGO=9999999.07
SET DIC("DR")=".02////EDEMA;.03////55"
DO ^DIC
KILL DIC,DD,DLAYGO,DA,D0
+3 SET X="PR"
SET DIC="^AUTTMSR("
SET DIC(0)="L"
SET DLAYGO=9999999.07
SET DIC("DR")=".02////PRESENTATION;.03////56"
DO ^DIC
KILL DIC,DD,DLAYGO,DA,D0
+4 SET DA=$ORDER(^AUTTMSR("B","EFF",0))
IF DA
SET DIE="^AUTTMSR("
SET DR=".01///EF"
DO ^DIE
+5 SET DA=$ORDER(^AUTTMSR("B","STN",0))
IF DA
SET DIE="^AUTTMSR("
SET DR=".01///SN"
DO ^DIE
+6 SET X="CXD"
SET DIC="^AUTTMSR("
SET DIC(0)="L"
SET DLAYGO=9999999.07
SET DIC("DR")=".02////CERVIX DILATATION;.03////57"
DO ^DIC
KILL DIC,DD,DLAYGO,DA,D0
+7 SET X="EF"
SET DIC="^AUTTMSR("
SET DIC(0)="L"
SET DLAYGO=9999999.07
SET DIC("DR")=".02////EFACEMENT;.03////58"
DO ^DIC
KILL DIC,DD,DLAYGO,DA,D0
+8 SET X="SN"
SET DIC="^AUTTMSR("
SET DIC(0)="L"
SET DLAYGO=9999999.07
SET DIC("DR")=".02////STATION (PREGNANCY);.03////59"
DO ^DIC
KILL DIC,DD,DLAYGO,DA,D0
+9 QUIT
HF ;
+1 WRITE !,"Adding a few new health factors"
+2 ;add current smoker & smokeless
+3 ;exposure to environmental tobacco smoke
+4 ;smoker in home
+5 SET X="CURRENT SMOKER & SMOKELESS"
SET DIC="^AUTTHF("
SET DIC(0)="L"
SET DLAYGO=9999999.64
DO ^DIC
KILL DIC,DD,DLAYGO,DA,D0
+6 SET X="EXPOSURE TO ENVIRONMENTAL TOBACCO SMOKE"
SET DIC="^AUTTHF("
SET DIC(0)="L"
SET DLAYGO=9999999.64
DO ^DIC
KILL DIC,DD,DLAYGO,DA,D0
+7 SET X="SMOKER IN HOME"
SET DIC="^AUTTHF("
SET DIC(0)="L"
SET DLAYGO=9999999.64
DO ^DIC
KILL DIC,DD,DLAYGO,DA,D0
+8 QUIT
SKINTEST ;
+1 WRITE !,"Adding CPT code to skin test entries."
+2 SET AUTT="SKCPT"
FOR AUTJ=1:1
SET AUTX=$TEXT(@AUTT+AUTJ)
SET AUTVAL=$PIECE(AUTX,";;",2)
IF AUTVAL="QUIT"!(AUTVAL="")
QUIT
Begin DoDot:1
+3 SET AUTY=0
FOR
SET AUTY=$ORDER(^AUTTSK("C",AUTVAL,AUTY))
IF AUTY'=+AUTY
QUIT
Begin DoDot:2
+4 SET DA=AUTY
SET DIE="^AUTTSK("
SET DR=".11///"_$PIECE(AUTX,";;",3)
DO ^DIE
IF $DATA(Y)
WRITE !,"updating skin test code ",AUTVAL,"failed. Notify database mgr. of incomplete SKIN TEST file."
+5 QUIT
End DoDot:2
+6 QUIT
End DoDot:1
+7 QUIT
EXAM ;
+1 WRITE !,"Adding CPT code to exam entries."
+2 SET AUTT="EXAMCPT"
FOR AUTJ=1:1
SET AUTX=$TEXT(@AUTT+AUTJ)
SET AUTVAL=$PIECE(AUTX,";;",2)
IF AUTVAL="QUIT"!(AUTVAL="")
QUIT
Begin DoDot:1
+3 SET AUTY=0
FOR
SET AUTY=$ORDER(^AUTTEXAM("C",AUTVAL,AUTY))
IF AUTY'=+AUTY
QUIT
Begin DoDot:2
+4 SET DA=AUTY
SET DIE="^AUTTEXAM("
SET DR=".11///"_$PIECE(AUTX,";;",3)
DO ^DIE
IF $DATA(Y)
WRITE !,"Updating exam ",AUTVAL,"failed. Notify database mgr. of incomplete EXAM file."
+5 QUIT
End DoDot:2
+6 QUIT
End DoDot:1
+7 QUIT
RCAT ;update recode category 9999999.081, field .01
+1 WRITE !,"Adding APC Recode Categories to Recode Category File.."
+2 SET DIC="^AUTTRCDC("
SET DIC(0)="L"
+3 SET AUTT="RCDC"
FOR AUTJ=1:1
SET AUTX=$TEXT(@AUTT+AUTJ)
SET AUTVAL=$PIECE(AUTX,";;",2)
IF AUTVAL="QUIT"!(AUTVAL="")
QUIT
Begin DoDot:1
+4 SET X=AUTVAL
DO ^DIC
IF Y=-1
WRITE "ADDING of Category ",AUTVAL," failed.. skipping. Notify Database Manager."
+5 QUIT
End DoDot:1
+6 KILL DIC,DD,DLAYGO,DA,DR
+7 QUIT
RECINJ ;update .02 and .04 of RECODE INJURY FILE
+1 WRITE !,"Adding Narrative and E-Codes to APC Injury code table..."
+2 SET AUTT="INJ02"
FOR AUTJ=1:1
SET AUTX=$TEXT(@AUTT+AUTJ)
SET AUTVAL=$PIECE(AUTX,";;",2)
IF AUTVAL="QUIT"!(AUTVAL="")
QUIT
Begin DoDot:1
+3 SET AUTCAT=$PIECE(AUTX,";;",4)
+4 SET AUTICD=$PIECE(AUTX,";;",3)
SET AUTICD=$ORDER(^ICD9("AB",AUTICD,0))
+5 IF AUTICD=""
WRITE !!,"Can't find ICD code ",$PIECE(AUTX,";;",3)," for APC code ",AUTVAL
+6 SET AUTICD="`"_AUTICD
+7 SET DA=$ORDER(^AUTTRIJ("B",AUTVAL,0))
IF DA=""
WRITE !,"Can't find entry ",AUTVAL," to edit.",!
QUIT
+8 SET DIE="^AUTTRIJ("
SET DR=".04///"_AUTCAT_";.02///"_AUTICD
+9 DO ^DIE
IF $DATA(Y)
WRITE !,"Editing APC INJURY Code ",AUTVAL," failed, notify database mgr. of incomplete RECODE INJURY file."
+10 QUIT
End DoDot:1
+11 QUIT
PPT ;EP - add presentation types to presentation type file
+1 WRITE !,"Adding Pregnancy Presentation Types to Presentation Type file..."
+2 SET DIC="^AUTTPPT("
SET DIC(0)="L"
+3 SET AUTT="PPTTYPE"
FOR AUTJ=1:1
SET AUTX=$TEXT(@AUTT+AUTJ)
SET AUTVAL=$PIECE(AUTX,";;",2)
IF AUTVAL="QUIT"!(AUTVAL="")
QUIT
Begin DoDot:1
+4 SET X=AUTVAL
SET DIC("DR")=".02////"_$PIECE(AUTX,";;",3)_";.03////"_$PIECE(AUTX,";;",4)
SET DLAYGO=9999999.87
DO ^DIC
KILL DA
IF Y=-1
WRITE !,"Adding Presentation Type ",X," failed. Notify database mgr. of incomplete PRESENTATION TYPE file.",!
+5 QUIT
End DoDot:1
+6 KILL DIC,DD,DLAYGO,DR,DA,DD
+7 QUIT
EOJ2 ;
+1 KILL AUTX,AUTVAL,AUTICD,AUTCAT
+2 QUIT
PPTTYPE ; presentation types
+1 ;;VERTEX;;1;;VT
+2 ;;COMPLETE BREECH;;2;;CB
+3 ;;DOUBLE FOOTLING;;3;;DF
+4 ;;SINGLE FOOTLING;;4;;SF
+5 ;;FRANK BREECH;;5;;FB
+6 ;;FACE;;6;;FA
+7 ;;UNSPECIFIED BREECH;;7;;UB
+8 ;;TRANSVERSE;;8;;TR
+9 ;;OTHER;;9;;OT
+10 ;;UNKNOWN;;U;;UNK
+11 ;;QUIT
RCDC ;
+1 ;;INFECTIVE & PARASITIC DIS.
+2 ;;NEOPLASMS
+3 ;;ENDOCR., NUTR., & METAB. DIS.
+4 ;;DIS. OF BLOOD & BLOOD-FORMING ORGANS
+5 ;;MENTAL DISORDERS
+6 ;;DIS. OF NERVOUS SYSTEM
+7 ;;EYE DISEASES
+8 ;;EAR DISEASES
+9 ;;DIS. OF CIRCULATORY SYSTEM
+10 ;;DIS. OF RESPIRATORY SYSTEM
+11 ;;DIS. OF DIGESTIVE SYSTEM
+12 ;;DIS. OF URINARY TRACT
+13 ;;DIS. OF FEMALE GENITALIA & BREAST
+14 ;;PREG., CHILDBIRTH & THE PUERPERIUM
+15 ;;DIS. OF SKIN & SUBCUTANEOUS TISSUE
+16 ;;MUSCULOSKEL SYSTEM & CONNECT. TISSUE
+17 ;;CONGENITAL ANOMALIES
+18 ;;SYMPTOMS & ILL-DEFINED CONDITION
+19 ;;SUPPLEMENTAL
+20 ;;ACCID. POISONINGS AND VIOLENCE
+21 ;;ALL DIS., MALE GENIT. (EXCL VD)
+22 ;;CAUSES OF PERNATAL MORB. & MORT.
+23 ;;QUIT
INJ02 ;
+1 ;;01;;E819.9;;MOTOR VEHICLE ACCIDENT
+2 ;;03;;E838.9;;WATER TRANSPORT
+3 ;;04;;E844.9;;AIR TRANSPORT
+4 ;;05;;E866.9;;ACCIDENTAL POISONING
+5 ;;06;;E888.;;ACCIDENTAL FALLS
+6 ;;07;;E899.;;FIRES AND FLAMES
+7 ;;08;;E904.9;;ENVIRONMENTAL FACTORS
+8 ;;09;;E905.9;;STINGS AND VENOMS
+9 ;;10;;E906.9;;ANIMAL RELATED, INCLUDING BITES
+10 ;;11;;E910.9;;DROWNING AND SUBMERSION
+11 ;;12;;E920.9;;CUTTING AND PIERCING OBJECTS
+12 ;;13;;E922.9;;FIREARMS ACCIDENTS
+13 ;;14;;E919.9;;MACHINERY
+14 ;;15;;E958.9;;SUICIDE ATTEMPT
+15 ;;16;;E968.9;;INJ. PURPOSELY INFLICTED BY OTHERS
+16 ;;17;;E967.9;;BATTERED CHILD
+17 ;;18;;E988.9;;UNDETERMINED CAUSE
+18 ;;19;;E988.8;;OTHER CAUSES
+19 ;;QUIT
IMMCPT ;
+1 ;;01;;
+2 ;;02;;90718
+3 ;;03;;90701
+4 ;;04;;90703
+5 ;;05;;90714
+6 ;;06;;90712
+7 ;;07;;90713
+8 ;;08;;
+9 ;;09;;
+10 ;;10;;
+11 ;;11;;90705
+12 ;;12;;90724
+13 ;;13;;90725
+14 ;;14;;90706
+15 ;;15;;90704
+16 ;;16;;90728
+17 ;;17;;90707
+18 ;;18;;90708
+19 ;;19;;90732
+20 ;;31;;90717
+21 ;;32;;
+22 ;;33;;90726
+23 ;;34;;90702
+24 ;;35;;90737
+25 ;;37;;90737
+26 ;;38;;90737
+27 ;;39;;90737
+28 ;;40;;90730
+29 ;;41;;90716
+30 ;;42;;90700
+31 ;;QUIT
EXAMCPT ;;
+1 ;;01;;
+2 ;;02;;
+3 ;;03;;
+4 ;;04;;
+5 ;;05;;
+6 ;;06;;
+7 ;;07;;
+8 ;;08;;
+9 ;;09;;
+10 ;;10;;
+11 ;;11;;
+12 ;;12;;
+13 ;;14;;
+14 ;;15;;57410
+15 ;;16;;
+16 ;;17;;92506
+17 ;;18;;
+18 ;;19;;92081
+19 ;;20;;
+20 ;;21;;92502
+21 ;;22;;
+22 ;;23;;92551
+23 ;;24;;92552
+24 ;;25;;92567
+25 ;;26;;92100
+26 ;;27;;
+27 ;;28;;
+28 ;;29;;
+29 ;;QUIT
SKCPT ;
+1 ;;23;;86490
+2 ;;24;;86585
+3 ;;21;;86580
+4 ;;22;;
+5 ;;20;;86585
+6 ;;QUIT
