Routine: ATXPOS3

ATXPOS3 ; IHS/OHPRD/TMJ -  IHS-TUCSON/GIS/THL ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

PNEUSUR ;EP -pneumococcal risk

 W !!,"Checking PNEUMOCOCCAL RISK Surveillance Taxonomy..."

 S ATXFLG="",X="SURVEILLANCE PNEUMOCOCCAL RISK",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 PNEUMOCOCCAL RISK",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)="DX AT RISK FOR PNEUMOCOCCUS",$P(^(0),U,4)="n",$P(^(0),U,5)=DUZ,$P(^(0),U,6)=2900101,$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)="^^2^2^2940510^^^^",^ATXAX(ATXTAX,11,1,0)="List of ICD diagnoses placing patients at risk for pneumococcal"

 S ^ATXAX(ATXTAX,11,2,0)="disease.  Used in Health Maintenance Reminder for pneumovax."

 S ^ATXAX(ATXTAX,21,0)="^9002226.02102^37^37",^ATXAX(ATXTAX,21,1,0)="011.50^011.64",^ATXAX(ATXTAX,21,2,0)="038.2^038.2",^ATXAX(ATXTAX,21,3,0)="042.0^044.9",^ATXAX(ATXTAX,21,4,0)="093.0^093.9"

 S ^ATXAX(ATXTAX,21,5,0)="140.0^208.91",^ATXAX(ATXTAX,21,6,0)="235.0^239.9",^ATXAX(ATXTAX,21,7,0)="242.00^246.1",^ATXAX(ATXTAX,21,8,0)="250.00^250.91"

 S ^ATXAX(ATXTAX,21,9,0)="251.0^271.9",^ATXAX(ATXTAX,21,10,0)="273.0^273.9",^ATXAX(ATXTAX,21,11,0)="275.0^275.9",^ATXAX(ATXTAX,21,12,0)="277.00^277.8"

 S ^ATXAX(ATXTAX,21,13,0)="281.00^284.93",^ATXAX(ATXTAX,21,14,0)="289.4^289.59",^ATXAX(ATXTAX,21,15,0)="303.00^303.93",^ATXAX(ATXTAX,21,16,0)="305.00^305.03",^ATXAX(ATXTAX,21,17,0)="331.7^331.7",^ATXAX(ATXTAX,21,18,0)="391.0^391.9"

 S ^ATXAX(ATXTAX,21,19,0)="393.^398.99",^ATXAX(ATXTAX,21,20,0)="402.00^405.91",^ATXAX(ATXTAX,21,21,0)="410.0^414.9",^ATXAX(ATXTAX,21,22,0)="581.0^583.9",^ATXAX(ATXTAX,21,23,0)="416.0^417.9",^ATXAX(ATXTAX,21,24,0)="423.0^425.9"

 S ^ATXAX(ATXTAX,21,25,0)="427.31^427.5",^ATXAX(ATXTAX,21,26,0)="428.0^429.89",^ATXAX(ATXTAX,21,27,0)="491.0^491.8",^ATXAX(ATXTAX,21,28,0)="492.0^511.9",^ATXAX(ATXTAX,21,29,0)="513.0^519.4",^ATXAX(ATXTAX,21,30,0)="570.^572.8"

 S ^ATXAX(ATXTAX,21,31,0)="585.^585.",^ATXAX(ATXTAX,21,32,0)="588.0^588.9",^ATXAX(ATXTAX,21,33,0)="590.00^590.81",^ATXAX(ATXTAX,21,34,0)="710.0^710.9",^ATXAX(ATXTAX,21,35,0)="714.0^714.9",^ATXAX(ATXTAX,21,36,0)="720.0^721.41"

 S ^ATXAX(ATXTAX,21,37,0)="865.00^865.19"

 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

ATXPOS3   ; IHS/OHPRD/TMJ -  IHS-TUCSON/GIS/THL ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;

PNEUSUR   ;EP -pneumococcal risk

 +1        WRITE !!,"Checking PNEUMOCOCCAL RISK Surveillance Taxonomy..."

 +2        SET ATXFLG=""

           SET X="SURVEILLANCE PNEUMOCOCCAL RISK"

           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 PNEUMOCOCCAL RISK"

           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)="DX AT RISK FOR PNEUMOCOCCUS"

           SET $PIECE(^(0),U,4)="n"

           SET $PIECE(^(0),U,5)=DUZ

           SET $PIECE(^(0),U,6)=2900101

           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)="^^2^2^2940510^^^^"

           SET ^ATXAX(ATXTAX,11,1,0)="List of ICD diagnoses placing patients at risk for pneumococcal"

 +9        SET ^ATXAX(ATXTAX,11,2,0)="disease.  Used in Health Maintenance Reminder for pneumovax."

 +10       SET ^ATXAX(ATXTAX,21,0)="^9002226.02102^37^37"

           SET ^ATXAX(ATXTAX,21,1,0)="011.50^011.64"

           SET ^ATXAX(ATXTAX,21,2,0)="038.2^038.2"

           SET ^ATXAX(ATXTAX,21,3,0)="042.0^044.9"

           SET ^ATXAX(ATXTAX,21,4,0)="093.0^093.9"

 +11       SET ^ATXAX(ATXTAX,21,5,0)="140.0^208.91"

           SET ^ATXAX(ATXTAX,21,6,0)="235.0^239.9"

           SET ^ATXAX(ATXTAX,21,7,0)="242.00^246.1"

           SET ^ATXAX(ATXTAX,21,8,0)="250.00^250.91"

 +12       SET ^ATXAX(ATXTAX,21,9,0)="251.0^271.9"

           SET ^ATXAX(ATXTAX,21,10,0)="273.0^273.9"

           SET ^ATXAX(ATXTAX,21,11,0)="275.0^275.9"

           SET ^ATXAX(ATXTAX,21,12,0)="277.00^277.8"

 +13       SET ^ATXAX(ATXTAX,21,13,0)="281.00^284.93"

           SET ^ATXAX(ATXTAX,21,14,0)="289.4^289.59"

           SET ^ATXAX(ATXTAX,21,15,0)="303.00^303.93"

           SET ^ATXAX(ATXTAX,21,16,0)="305.00^305.03"

           SET ^ATXAX(ATXTAX,21,17,0)="331.7^331.7"

           SET ^ATXAX(ATXTAX,21,18,0)="391.0^391.9"

 +14       SET ^ATXAX(ATXTAX,21,19,0)="393.^398.99"

           SET ^ATXAX(ATXTAX,21,20,0)="402.00^405.91"

           SET ^ATXAX(ATXTAX,21,21,0)="410.0^414.9"

           SET ^ATXAX(ATXTAX,21,22,0)="581.0^583.9"

           SET ^ATXAX(ATXTAX,21,23,0)="416.0^417.9"

           SET ^ATXAX(ATXTAX,21,24,0)="423.0^425.9"

 +15       SET ^ATXAX(ATXTAX,21,25,0)="427.31^427.5"

           SET ^ATXAX(ATXTAX,21,26,0)="428.0^429.89"

           SET ^ATXAX(ATXTAX,21,27,0)="491.0^491.8"

           SET ^ATXAX(ATXTAX,21,28,0)="492.0^511.9"

           SET ^ATXAX(ATXTAX,21,29,0)="513.0^519.4"

           SET ^ATXAX(ATXTAX,21,30,0)="570.^572.8"

 +16       SET ^ATXAX(ATXTAX,21,31,0)="585.^585."

           SET ^ATXAX(ATXTAX,21,32,0)="588.0^588.9"

           SET ^ATXAX(ATXTAX,21,33,0)="590.00^590.81"

           SET ^ATXAX(ATXTAX,21,34,0)="710.0^710.9"

           SET ^ATXAX(ATXTAX,21,35,0)="714.0^714.9"

           SET ^ATXAX(ATXTAX,21,36,0)="720.0^721.41"

 +17       SET ^ATXAX(ATXTAX,21,37,0)="865.00^865.19"

 +18       SET DA=ATXTAX

           SET DIK="^ATXAX("

           DO IX1^DIK

 +19      ;update all these codes in icd9 file

           SET ATXX=ATXTAX

           DO ZTM^ATXAX

 +20       IF $ORDER(^ATXPAT(ATXTAX,11,0))

               WRITE !,"Pts already entered for this taxonomy.",!

               QUIT

 +21       SET ATXX=ATXTAX

 +22       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"

 +23      ;enter patients into patient taxonomy

           DO TSKMN^ATXENP

 +24       QUIT

ATXPOS3.m