ATXPOS2 ; TUCSON-OHPRD/LAB - IHS-TUCSON/GIS/THL ; [ 10/12/94 1:37 PM ]
;;5.0;TAXONOMY SYSTEM;;OCT 12, 1994
OBESSUR ;EP -surveillance obesity
W !!,"Checking OBESITY Surveillance Taxonomy..."
S ATXFLG="",X="SURVEILLANCE OBESITY",DIC="^ATXAX(",DIC(0)="MO" D ^DIC K DIC,DA,DR,DIADD,DLAYGO,D0
S ATXTAX=+Y I ATXTAX>0 S DA=ATXTAX,DIK="^ATXAX(" D ^DIK K DIK,DA,DR
S:ATXTAX>0 DINUM=ATXTAX S ATXFLG="",X="SURVEILLANCE OBESITY",DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DR,DIADD,DLAYGO,D0
S ATXTAX=+Y
S $P(^ATXAX(ATXTAX,0),U,2)="OBES 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: 278.0"
S ^ATXAX(ATXTAX,21,0)="^9002226.02102^1^1",^ATXAX(ATXTAX,21,1,0)="278.0^278.0"
S DA=ATXTAX,DIK="^ATXAX(" D IX1^DIK
S ATXX=ATXTAX D ZTM^ATXAX
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
Q
TBSUR ;EP - surveillance tb
W !!,"Checking TB Surveillance Taxonomy..."
S ATXFLG="",X="SURVEILLANCE TUBERCULOSIS",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 TUBERCULOSIS",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)="TB 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: 010.0-018.96, late effects 137.0-137.4; Positive PPD, Tine or Monovac - 795.5"
S ^ATXAX(ATXTAX,21,0)="^9002226.02102^3^3",^ATXAX(ATXTAX,21,1,0)="010.00^018.96",^ATXAX(ATXTAX,21,2,0)="137.0^137.4",^ATXAX(ATXTAX,21,3,0)="795.5^795.5"
S DA=ATXTAX,DIK="^ATXAX(" D IX1^DIK
S ATXX=ATXTAX D 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
PNEUSUR ;EP -pneumococcal risk
D PNEUSUR^ATXPOS3
Q
ATXPOS2 ; TUCSON-OHPRD/LAB - IHS-TUCSON/GIS/THL ; [ 10/12/94 1:37 PM ]
+1 ;;5.0;TAXONOMY SYSTEM;;OCT 12, 1994
OBESSUR ;EP -surveillance obesity
+1 WRITE !!,"Checking OBESITY Surveillance Taxonomy..."
+2 SET ATXFLG=""
SET X="SURVEILLANCE OBESITY"
SET DIC="^ATXAX("
SET DIC(0)="MO"
DO ^DIC
KILL DIC,DA,DR,DIADD,DLAYGO,D0
+3 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 OBESITY"
SET DIC="^ATXAX("
SET DIC(0)="L"
SET DIADD=1
SET DLAYGO=9002226
DO ^DIC
KILL DIC,DA,DR,DIADD,DLAYGO,D0
+5 SET ATXTAX=+Y
+6 SET $PIECE(^ATXAX(ATXTAX,0),U,2)="OBES 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: 278.0"
+9 SET ^ATXAX(ATXTAX,21,0)="^9002226.02102^1^1"
SET ^ATXAX(ATXTAX,21,1,0)="278.0^278.0"
+10 SET DA=ATXTAX
SET DIK="^ATXAX("
DO IX1^DIK
+11 SET ATXX=ATXTAX
DO ZTM^ATXAX
+12 IF $ORDER(^ATXPAT(ATXTAX,11,0))
WRITE !,"Pts already entered for this taxonomy.",!
QUIT
+13 SET ATXX=ATXTAX
+14 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"
+15 DO TSKMN^ATXENP
+16 QUIT
TBSUR ;EP - surveillance tb
+1 WRITE !!,"Checking TB Surveillance Taxonomy..."
+2 SET ATXFLG=""
SET X="SURVEILLANCE TUBERCULOSIS"
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 TUBERCULOSIS"
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)="TB 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: 010.0-018.96, late effects 137.0-137.4; Positive PPD, Tine or Monovac - 795.5"
+9 SET ^ATXAX(ATXTAX,21,0)="^9002226.02102^3^3"
SET ^ATXAX(ATXTAX,21,1,0)="010.00^018.96"
SET ^ATXAX(ATXTAX,21,2,0)="137.0^137.4"
SET ^ATXAX(ATXTAX,21,3,0)="795.5^795.5"
+10 SET DA=ATXTAX
SET DIK="^ATXAX("
DO IX1^DIK
+11 ;update all these codes in icd9 file
SET ATXX=ATXTAX
DO ZTM^ATXAX
+12 IF $ORDER(^ATXPAT(ATXTAX,11,0))
WRITE !,"Pts already entered for this taxonomy.",!
QUIT
+13 SET ATXX=ATXTAX
+14 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"
+15 ;enter patients into patient taxonomy
DO TSKMN^ATXENP
+16 QUIT
PNEUSUR ;EP -pneumococcal risk
+1 DO PNEUSUR^ATXPOS3
+2 QUIT
