ATXPOS1.m

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