BATPOST.m

BATPOST ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;

 ;;1.0;IHS ASTHMA REGISTER;;FEB 19, 2003

 ;

 ;

ENV ;EP 

 ; The following line prevents the "Disable Options..." and "Move

 ; Routines..." questions from being asked during the install.

 I $G(XPDENV)=1 S (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0

 Q

 ;

POST ;EP

 NEW X

 S X=$$ADD^XPDMENU("BAT MENU SETUP","APCL TAXONOMY SETUP","TX",20)

 I 'X W "Attempt to add taxonomy setup option failed.." H 3

 S X=$$ADD^XPDMENU("BAT MENU PATIENT MANAGEMENT","APCHSBRW","BHS",80)

 I 'X W "Attempt to add health summary option failed.." H 3

 S X=$$ADD^XPDMENU("BAT MENU PATIENT MANAGEMENT","APCHSUM","HS",81)

 I 'X W "Attempt to add health summary option failed.." H 3

 ;install icd taxonomy of asthma dxs

 D ^BATTX

 D DRUGS

 D AST

 D HAST

 D BAT

 Q

AST ;

 D ^XBFMK

 Q:$D(^APCDTKW("B","AST"))

 S X="AST",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000010;.04///[APCD AST];.06///ASTHMA;.07///0;.08///1"

 K DD,D0,DO

 D FILE^DICN

 I Y=-1 W !!,"Adding AST mnemonic failed." H 4

 K DIC,DD,D0,DO

 Q

HAST ;

 D ^XBFMK

 Q:$D(^APCDTKW("B","HAST"))

 S X="HAST",DIC(0)="L",DIC="^APCDTKW(",DIC("DR")=".03///9000001;.04///[APCD HAST];.06///Historical Asthma;.07///0;.08///0;.09///9000010.41;.12///Historical Asthma;.15///81;.16///86"

 K DD,D0,DO

 D FILE^DICN

 I Y=-1 W !!,"Adding HAST mnemonic failed." H 4

 K DIC,DD,D0,DO

 Q

BAT ;EP

 D ^XBFMK

 Q:$D(^APCHSUP("B","ASTHMA"))

 S X="ASTHMA",DIC(0)="L",DIC="^APCHSUP(",DIC("DR")="1100///D AST^APCHS9"

 K DD,D0,DO

 D FILE^DICN

 I Y=-1 W !!,"Adding health summary supplement failed." H 4

 K DIC,DD,D0,DO

 Q

 Q

 ;

 ;;

DRUGS ;set up drug taxonomies

 S ATXFLG=1

 S BATX="BAT ASTHMA RELIEVER MEDS" D DRUG1

 S BATX="BAT ASTHMA INHALED STEROIDS" D DRUG1

 S BATX="BAT ASTHMA CONTROLLER MEDS" D DRUG1

 K ATXFLG,BATX,BATDA,BATTX

 Q

DRUG1 ;

 W !,"Creating ",BATX," Taxonomy..."

 S BATDA=$O(^ATXAX("B",BATX,0))

 Q:BATDA  ;taxonomy already exisits

 S X=BATX,DIC="^ATXAX(",DIC(0)="L",DIADD=1,DLAYGO=9002226 D ^DIC K DIC,DA,DIADD,DLAYGO,I

 I Y=-1 W !!,"ERROR IN CREATING ",BATX," TAX" Q

 S BATTX=+Y,$P(^ATXAX(BATTX,0),U,2)=BATX,$P(^(0),U,8)=0,$P(^(0),U,9)=DT,$P(^(0),U,12)=173,$P(^(0),U,13)=0,$P(^(0),U,15)=50,^ATXAX(BATTX,21,0)="^9002226.02101A^0^0"

 S DA=BATTX,DIK="^ATXAX(" D IX1^DIK

 Q

 ;

BATPOST   ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;

 +1       ;;1.0;IHS ASTHMA REGISTER;;FEB 19, 2003

 +2       ;

 +3       ;

ENV       ;EP 

 +1       ; The following line prevents the "Disable Options..." and "Move

 +2       ; Routines..." questions from being asked during the install.

 +3        IF $GET(XPDENV)=1

               SET (XPDDIQ("XPZ1"),XPDDIQ("XPZ2"))=0

 +4        QUIT 

 +5       ;

POST      ;EP

 +1        NEW X

 +2        SET X=$$ADD^XPDMENU("BAT MENU SETUP","APCL TAXONOMY SETUP","TX",20)

 +3        IF 'X

               WRITE "Attempt to add taxonomy setup option failed.."

               HANG 3

 +4        SET X=$$ADD^XPDMENU("BAT MENU PATIENT MANAGEMENT","APCHSBRW","BHS",80)

 +5        IF 'X

               WRITE "Attempt to add health summary option failed.."

               HANG 3

 +6        SET X=$$ADD^XPDMENU("BAT MENU PATIENT MANAGEMENT","APCHSUM","HS",81)

 +7        IF 'X

               WRITE "Attempt to add health summary option failed.."

               HANG 3

 +8       ;install icd taxonomy of asthma dxs

 +9        DO ^BATTX

 +10       DO DRUGS

 +11       DO AST

 +12       DO HAST

 +13       DO BAT

 +14       QUIT 

AST       ;

 +1        DO ^XBFMK

 +2        IF $DATA(^APCDTKW("B","AST"))

               QUIT 

 +3        SET X="AST"

           SET DIC(0)="L"

           SET DIC="^APCDTKW("

           SET DIC("DR")=".03///9000010;.04///[APCD AST];.06///ASTHMA;.07///0;.08///1"

 +4        KILL DD,D0,DO

 +5        DO FILE^DICN

 +6        IF Y=-1

               WRITE !!,"Adding AST mnemonic failed."

               HANG 4

 +7        KILL DIC,DD,D0,DO

 +8        QUIT 

HAST      ;

 +1        DO ^XBFMK

 +2        IF $DATA(^APCDTKW("B","HAST"))

               QUIT 

 +3        SET X="HAST"

           SET DIC(0)="L"

           SET DIC="^APCDTKW("

           SET DIC("DR")=".03///9000001;.04///[APCD HAST];.06///Historical Asthma;.07///0;.08///0;.09///9000010.41;.12///Historical Asthma;.15///81;.16///86"

 +4        KILL DD,D0,DO

 +5        DO FILE^DICN

 +6        IF Y=-1

               WRITE !!,"Adding HAST mnemonic failed."

               HANG 4

 +7        KILL DIC,DD,D0,DO

 +8        QUIT 

BAT       ;EP

 +1        DO ^XBFMK

 +2        IF $DATA(^APCHSUP("B","ASTHMA"))

               QUIT 

 +3        SET X="ASTHMA"

           SET DIC(0)="L"

           SET DIC="^APCHSUP("

           SET DIC("DR")="1100///D AST^APCHS9"

 +4        KILL DD,D0,DO

 +5        DO FILE^DICN

 +6        IF Y=-1

               WRITE !!,"Adding health summary supplement failed."

               HANG 4

 +7        KILL DIC,DD,D0,DO

 +8        QUIT 

 +9        QUIT 

 +10      ;

 +11      ;;

DRUGS     ;set up drug taxonomies

 +1        SET ATXFLG=1

 +2        SET BATX="BAT ASTHMA RELIEVER MEDS"

           DO DRUG1

 +3        SET BATX="BAT ASTHMA INHALED STEROIDS"

           DO DRUG1

 +4        SET BATX="BAT ASTHMA CONTROLLER MEDS"

           DO DRUG1

 +5        KILL ATXFLG,BATX,BATDA,BATTX

 +6        QUIT 

DRUG1     ;

 +1        WRITE !,"Creating ",BATX," Taxonomy..."

 +2        SET BATDA=$ORDER(^ATXAX("B",BATX,0))

 +3       ;taxonomy already exisits

           IF BATDA

               QUIT 

 +4        SET X=BATX

           SET DIC="^ATXAX("

           SET DIC(0)="L"

           SET DIADD=1

           SET DLAYGO=9002226

           DO ^DIC

           KILL DIC,DA,DIADD,DLAYGO,I

 +5        IF Y=-1

               WRITE !!,"ERROR IN CREATING ",BATX," TAX"

               QUIT 

 +6        SET BATTX=+Y

           SET $PIECE(^ATXAX(BATTX,0),U,2)=BATX

           SET $PIECE(^(0),U,8)=0

           SET $PIECE(^(0),U,9)=DT

           SET $PIECE(^(0),U,12)=173

           SET $PIECE(^(0),U,13)=0

           SET $PIECE(^(0),U,15)=50

           SET ^ATXAX(BATTX,21,0)="^9002226.02101A^0^0"

 +7        SET DA=BATTX

           SET DIK="^ATXAX("

           DO IX1^DIK

 +8        QUIT 

 +9       ;