ATXPOS1 ; TUCSON-OHPRD/LAB - IHS-TUCSON/GIS/THL ; [ 10/12/94 1:37 PM ]
;;5.0;TAXONOMY SYSTEM;;OCT 12, 1994
REBUILD ;EP
I '$D(^ATXAX(0)) W !!,"You do not have the Taxonomy System installed....I can not",!,"update the appropriate entries in the taxonomy file for",!,"the Diabetes Program QA Audit system." H 5 Q
D KILL
S ATXFLG=1
D ADD
D EXIT
Q
KILL ;
K DD,DINUM,DA,DIADD,DLAYGO,DA,DR,DI,A,B,S,D,X,Y,Z,DIC,DIE,D1,DDC,DDH,DIG,DIH,DIU,DIV,DIW,DQ
K D,D0,D1,DA,DC,DDF,DDT,DE,DG,DH,DI,DIC,DIE,DIF,DIEL,DIFL,DIFLD,DIP,DK,DL,DLAYGO,DM,DN,DP,DQ,DR,DSEC,I,N,NO,X,Y,%,%Y,%X
Q
EXIT ;
D KILL
K ATXAX,ATXX,ATXTAX
Q
ADD ;
D DMSUR,HTNSUR,OBESSUR^ATXPOS2,TBSUR^ATXPOS2,PNEUSUR^ATXPOS2,HYSSUR
Q
DMSUR ;diabetes surveillance
W !!,"Checking DM Surveillance Taxonomy..."
S ATXFLG="",X="SURVEILLANCE DIABETES",DIC="^ATXAX(",DIC(0)="MO" D ^DIC K DIC,DA,DINUM,DR,DIADD,DLAYGO,D0,DD,DD
S ATXTAX=+Y I ATXTAX>0 S DA=ATXTAX,DIK="^ATXAX(" D ^DIK K DIK,DA,DR ;delete current one if it exists
S:ATXTAX>0 DINUM=ATXTAX S ATXFLG="",X="SURVEILLANCE DIABETES",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DINUM,DR,DIADD,DLAYGO,D0,DD
S ATXTAX=+Y
S $P(^ATXAX(ATXTAX,0),U,2)="DM SURV - USED BY HLTH SUMM",$P(^(0),U,4)="n",$P(^(0),U,5)=DUZ,$P(^(0),U,6)=2600101,$P(^(0),U,8)=1,$P(^(0),U,9)=DT,$P(^(0),U,12)=31,$P(^(0),U,13)=1,$P(^(0),U,14)="BA"
S $P(^ATXAX(ATXTAX,0),U,15)=80,$P(^(0),U,16)=1
S ^ATXAX(ATXTAX,11,0)="^^1^1^2940510^^^^",^ATXAX(ATXTAX,11,1,0)="ICD codes: 250.00-250.93"
S ^ATXAX(ATXTAX,21,0)="^9002226.02102^1^1",^ATXAX(ATXTAX,21,1,0)="250.00^250.93"
S DA=ATXTAX,DIK="^ATXAX(" D IX1^DIK
S ATXX=ATXTAX D KILL,ZTM^ATXAX ;update all these codes in icd9 file
I $O(^ATXPAT(ATXTAX,11,0)) W !,"Pts already entered for this taxonomy.",! Q
S ATXX=ATXTAX I '$D(^ATXPAT(ATXX,0)) S DIADD="",DIC="^ATXPAT(",DIC(0)="L",X="`"_ATXX,DIC("DR")=".02////"_DT_";.03////"_DUZ D ^DIC K DIADD,DIC,DR S ^ATXPAT(ATXX,11,0)="^9002227.01101PA^0^0"
D TSKMN^ATXENP ;enter patients into patient taxonomy
Q
HTNSUR ;surveillance htn
W !!,"Checking HTN Surveillance Taxonomy..."
S ATXFLG="",X="SURVEILLANCE HYPERTENSION",DIC="^ATXAX(",DIC(0)="MO" D ^DIC K DIC,DA,DINUM,DR,DIADD,DLAYGO,D0,DD
S ATXTAX=+Y I ATXTAX>0 S DA=ATXTAX,DIK="^ATXAX(" D ^DIK K DIK,DA,DR ;delete current one if it exists
S:ATXTAX>0 DINUM=ATXTAX S ATXFLG="",X="SURVEILLANCE HYPERTENSION",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DINUM,DR,DIADD,DLAYGO,D0,DD
S ATXTAX=+Y
S $P(^ATXAX(ATXTAX,0),U,2)="HTN SURV - USED BY HLTH SUMM",$P(^(0),U,4)="n",$P(^(0),U,5)=DUZ,$P(^(0),U,6)=2600101,$P(^(0),U,8)=1,$P(^(0),U,9)=DT,$P(^(0),U,12)=31,$P(^(0),U,13)=1,$P(^(0),U,14)="BA"
S $P(^ATXAX(ATXTAX,0),U,15)=80,$P(^(0),U,16)=1
S ^ATXAX(ATXTAX,11,0)="^^1^1^2940510^^^^",^ATXAX(ATXTAX,11,1,0)="ICD codes: 401.0-405.99"
S ^ATXAX(ATXTAX,21,0)="^9002226.02102^1^1",^ATXAX(ATXTAX,21,1,0)="401.0^405.99"
S DA=ATXTAX,DIK="^ATXAX(" D IX1^DIK
S ATXX=ATXTAX
D KILL,ZTM^ATXAX ;update all these codes in icd9 file
I $O(^ATXPAT(ATXTAX,11,0)) W !,"Pts already entered for this taxonomy.",! Q
S ATXX=ATXTAX
I '$D(^ATXPAT(ATXX,0)) S DIADD="",DIC="^ATXPAT(",DIC(0)="L",X="`"_ATXX,DIC("DR")=".02////"_DT_";.03////"_DUZ D ^DIC K DIADD,DIC,DR S ^ATXPAT(ATXX,11,0)="^9002227.01101PA^0^0"
D TSKMN^ATXENP ;enter patients into patient taxonomy
Q
HYSSUR ;surveillance hysterectomy
W !!,"Checking HYSTERECTOMY Surveillance Taxonomy..."
S ATXFLG="",X="SURVEILLANCE HYSTERECTOMY",DIC="^ATXAX(",DIC(0)="MO" D ^DIC K DIC,DA,DINUM,DR,DIADD,DLAYGO,D0,DD
S ATXTAX=+Y I ATXTAX>0 S DA=ATXTAX,DIK="^ATXAX(" D ^DIK K DIK,DA,DR ;delete current one if it exists
S:ATXTAX>0 DINUM=ATXTAX S ATXFLG="",X="SURVEILLANCE HYSTERECTOMY",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DINUM,DR,DIADD,DLAYGO,D0,DD
S ATXTAX=+Y
S $P(^ATXAX(ATXTAX,0),U,2)="HYS SURV - USED BY HLTH SUMM",$P(^(0),U,4)="n",$P(^(0),U,5)=DUZ,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=255,$P(^(0),U,13)=1,$P(^(0),U,14)="BA"
S $P(^ATXAX(ATXTAX,0),U,15)=80.1,$P(^(0),U,16)=1
S ^ATXAX(ATXTAX,21,0)="^9002226.02102^2^2",^ATXAX(ATXTAX,21,1,0)="68.3^68.7",^ATXAX(ATXTAX,21,2,0)="68.9^68.9"
S DA=ATXTAX,DIK="^ATXAX(" D IX1^DIK
S ATXX=ATXTAX D KILL,ZTM^ATXAX ;update all these codes in icd9 file
Q
ATXPOS1 ; TUCSON-OHPRD/LAB - IHS-TUCSON/GIS/THL ; [ 10/12/94 1:37 PM ]
+1 ;;5.0;TAXONOMY SYSTEM;;OCT 12, 1994
REBUILD ;EP
+1 IF '$DATA(^ATXAX(0))
WRITE !!,"You do not have the Taxonomy System installed....I can not",!,"update the appropriate entries in the taxonomy file for",!,"the Diabetes Program QA Audit system."
HANG 5
QUIT
+2 DO KILL
+3 SET ATXFLG=1
+4 DO ADD
+5 DO EXIT
+6 QUIT
KILL ;
+1 KILL DD,DINUM,DA,DIADD,DLAYGO,DA,DR,DI,A,B,S,D,X,Y,Z,DIC,DIE,D1,DDC,DDH,DIG,DIH,DIU,DIV,DIW,DQ
+2 KILL D,D0,D1,DA,DC,DDF,DDT,DE,DG,DH,DI,DIC,DIE,DIF,DIEL,DIFL,DIFLD,DIP,DK,DL,DLAYGO,DM,DN,DP,DQ,DR,DSEC,I,N,NO,X,Y,%,%Y,%X
+3 QUIT
EXIT ;
+1 DO KILL
+2 KILL ATXAX,ATXX,ATXTAX
+3 QUIT
ADD ;
+1 DO DMSUR
DO HTNSUR
DO OBESSUR^ATXPOS2
DO TBSUR^ATXPOS2
DO PNEUSUR^ATXPOS2
DO HYSSUR
+2 QUIT
DMSUR ;diabetes surveillance
+1 WRITE !!,"Checking DM Surveillance Taxonomy..."
+2 SET ATXFLG=""
SET X="SURVEILLANCE DIABETES"
SET DIC="^ATXAX("
SET DIC(0)="MO"
DO ^DIC
KILL DIC,DA,DINUM,DR,DIADD,DLAYGO,D0,DD,DD
+3 ;delete current one if it exists
SET ATXTAX=+Y
IF ATXTAX>0
SET DA=ATXTAX
SET DIK="^ATXAX("
DO ^DIK
KILL DIK,DA,DR
+4 IF ATXTAX>0
SET DINUM=ATXTAX
SET ATXFLG=""
SET X="SURVEILLANCE DIABETES"
SET DIC="^ATXAX("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002226
DO ^DIC
KILL DIC,DA,DINUM,DR,DIADD,DLAYGO,D0,DD
+5 SET ATXTAX=+Y
+6 SET $PIECE(^ATXAX(ATXTAX,0),U,2)="DM SURV - USED BY HLTH SUMM"
SET $PIECE(^(0),U,4)="n"
SET $PIECE(^(0),U,5)=DUZ
SET $PIECE(^(0),U,6)=2600101
SET $PIECE(^(0),U,8)=1
SET $PIECE(^(0),U,9)=DT
SET $PIECE(^(0),U,12)=31
SET $PIECE(^(0),U,13)=1
SET $PIECE(^(0),U,14)="BA"
+7 SET $PIECE(^ATXAX(ATXTAX,0),U,15)=80
SET $PIECE(^(0),U,16)=1
+8 SET ^ATXAX(ATXTAX,11,0)="^^1^1^2940510^^^^"
SET ^ATXAX(ATXTAX,11,1,0)="ICD codes: 250.00-250.93"
+9 SET ^ATXAX(ATXTAX,21,0)="^9002226.02102^1^1"
SET ^ATXAX(ATXTAX,21,1,0)="250.00^250.93"
+10 SET DA=ATXTAX
SET DIK="^ATXAX("
DO IX1^DIK
+11 ;update all these codes in icd9 file
SET ATXX=ATXTAX
DO KILL
DO ZTM^ATXAX
+12 IF $ORDER(^ATXPAT(ATXTAX,11,0))
WRITE !,"Pts already entered for this taxonomy.",!
QUIT
+13 SET ATXX=ATXTAX
IF '$DATA(^ATXPAT(ATXX,0))
SET DIADD=""
SET DIC="^ATXPAT("
SET DIC(0)="L"
SET X="`"_ATXX
SET DIC("DR")=".02////"_DT_";.03////"_DUZ
DO ^DIC
KILL DIADD,DIC,DR
SET ^ATXPAT(ATXX,11,0)="^9002227.01101PA^0^0"
+14 ;enter patients into patient taxonomy
DO TSKMN^ATXENP
+15 QUIT
HTNSUR ;surveillance htn
+1 WRITE !!,"Checking HTN Surveillance Taxonomy..."
+2 SET ATXFLG=""
SET X="SURVEILLANCE HYPERTENSION"
SET DIC="^ATXAX("
SET DIC(0)="MO"
DO ^DIC
KILL DIC,DA,DINUM,DR,DIADD,DLAYGO,D0,DD
+3 ;delete current one if it exists
SET ATXTAX=+Y
IF ATXTAX>0
SET DA=ATXTAX
SET DIK="^ATXAX("
DO ^DIK
KILL DIK,DA,DR
+4 IF ATXTAX>0
SET DINUM=ATXTAX
SET ATXFLG=""
SET X="SURVEILLANCE HYPERTENSION"
SET DIC="^ATXAX("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002226
DO ^DIC
KILL DIC,DA,DINUM,DR,DIADD,DLAYGO,D0,DD
+5 SET ATXTAX=+Y
+6 SET $PIECE(^ATXAX(ATXTAX,0),U,2)="HTN SURV - USED BY HLTH SUMM"
SET $PIECE(^(0),U,4)="n"
SET $PIECE(^(0),U,5)=DUZ
SET $PIECE(^(0),U,6)=2600101
SET $PIECE(^(0),U,8)=1
SET $PIECE(^(0),U,9)=DT
SET $PIECE(^(0),U,12)=31
SET $PIECE(^(0),U,13)=1
SET $PIECE(^(0),U,14)="BA"
+7 SET $PIECE(^ATXAX(ATXTAX,0),U,15)=80
SET $PIECE(^(0),U,16)=1
+8 SET ^ATXAX(ATXTAX,11,0)="^^1^1^2940510^^^^"
SET ^ATXAX(ATXTAX,11,1,0)="ICD codes: 401.0-405.99"
+9 SET ^ATXAX(ATXTAX,21,0)="^9002226.02102^1^1"
SET ^ATXAX(ATXTAX,21,1,0)="401.0^405.99"
+10 SET DA=ATXTAX
SET DIK="^ATXAX("
DO IX1^DIK
+11 SET ATXX=ATXTAX
+12 ;update all these codes in icd9 file
DO KILL
DO ZTM^ATXAX
+13 IF $ORDER(^ATXPAT(ATXTAX,11,0))
WRITE !,"Pts already entered for this taxonomy.",!
QUIT
+14 SET ATXX=ATXTAX
+15 IF '$DATA(^ATXPAT(ATXX,0))
SET DIADD=""
SET DIC="^ATXPAT("
SET DIC(0)="L"
SET X="`"_ATXX
SET DIC("DR")=".02////"_DT_";.03////"_DUZ
DO ^DIC
KILL DIADD,DIC,DR
SET ^ATXPAT(ATXX,11,0)="^9002227.01101PA^0^0"
+16 ;enter patients into patient taxonomy
DO TSKMN^ATXENP
+17 QUIT
HYSSUR ;surveillance hysterectomy
+1 WRITE !!,"Checking HYSTERECTOMY Surveillance Taxonomy..."
+2 SET ATXFLG=""
SET X="SURVEILLANCE HYSTERECTOMY"
SET DIC="^ATXAX("
SET DIC(0)="MO"
DO ^DIC
KILL DIC,DA,DINUM,DR,DIADD,DLAYGO,D0,DD
+3 ;delete current one if it exists
SET ATXTAX=+Y
IF ATXTAX>0
SET DA=ATXTAX
SET DIK="^ATXAX("
DO ^DIK
KILL DIK,DA,DR
+4 IF ATXTAX>0
SET DINUM=ATXTAX
SET ATXFLG=""
SET X="SURVEILLANCE HYSTERECTOMY"
SET DIC="^ATXAX("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002226
DO ^DIC
KILL DIC,DA,DINUM,DR,DIADD,DLAYGO,D0,DD
+5 SET ATXTAX=+Y
+6 SET $PIECE(^ATXAX(ATXTAX,0),U,2)="HYS SURV - USED BY HLTH SUMM"
SET $PIECE(^(0),U,4)="n"
SET $PIECE(^(0),U,5)=DUZ
SET $PIECE(^(0),U,8)=0
SET $PIECE(^(0),U,9)=DT
SET $PIECE(^(0),U,12)=255
SET $PIECE(^(0),U,13)=1
SET $PIECE(^(0),U,14)="BA"
+7 SET $PIECE(^ATXAX(ATXTAX,0),U,15)=80.1
SET $PIECE(^(0),U,16)=1
+8 SET ^ATXAX(ATXTAX,21,0)="^9002226.02102^2^2"
SET ^ATXAX(ATXTAX,21,1,0)="68.3^68.7"
SET ^ATXAX(ATXTAX,21,2,0)="68.9^68.9"
+9 SET DA=ATXTAX
SET DIK="^ATXAX("
DO IX1^DIK
+10 ;update all these codes in icd9 file
SET ATXX=ATXTAX
DO KILL
DO ZTM^ATXAX
+11 QUIT
