BATBLG.m

BATBLG ; IHS/CMI/LAB - ;

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

 ;

 ;

 W:$D(IOF) @IOF

 W !!,"This option is used to initially populate your register with a pre-defined",!,"set of patients.  If you continue with this option your patient file will"

 W !,"be scanned and all patients within a [user defined] age range living in",!,"[user defined] community with at least two asthma visits (POV with",!,"ICD-9 codes 493.00-493.99) in the past year will be automatically added to the"

 W !,"register with a status of Unreviewed.",!!

 S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="N" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) D EOJ Q

 I 'Y D EOJ Q

COM ;

 K BATCOMM

 S DIR(0)="S^O:One particular Community;A:All Communities;S:Selected Set of Communities (Taxonomy)",DIR("A")="Include patients who live in",DIR("B")="O" K DA D ^DIR K DIR

 G:$D(DIRUT) EOJ

 I Y="A" W !!,"Patients from all communities will be included in the report.",! G AGE

 I Y="O" D  G:'$D(BATCOMM) COM G AGE

 .K BATCOMM

 .S DIC="^AUTTCOM(",DIC(0)="AEMQ",DIC("A")="Which COMMUNITY: " D ^DIC K DIC

 .Q:Y=-1

 .S BATCOMM($P(^AUTTCOM(+Y,0),U))=""

 K BATCOMM S X="COMMUNITY",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" S BATERR=1 Q

 D ^AMQQGTX0(+Y,"BATCOMM(")

 I '$D(BATCOMM) G COM

 I $D(BATCOMM("*")) K BATCOMM G COM

 ;

AGE ;Age Screening

 K BATAGE,BATAGET

 W ! S DIR(0)="YO",DIR("A")="Would you like to restrict the report by Patient age range",DIR("B")="YES"

 S DIR("?")="If you wish to include visits from ALL age ranges, anwser No.  If you wish to include visits for only patients within a particular age range, enter Yes."

 D ^DIR K DIR

 G:$D(DIRUT) COM

 I 'Y G PROCESS

 ;

AGER ;Age Screening

 W !

 S DIR(0)="FO^1:7",DIR("A")="Enter an Age Range (e.g. 5-12,1-1)" D ^DIR

 I Y="" W !!,"No age range entered." G AGE

 I Y'?1.3N1"-"1.3N W !!,$C(7),$C(7),"Enter a numeric range in the format nnn-nnn. e.g. 0-5, 0-99, 5-20." G AGER

 S BATAGET=Y

 ;

 ;

PROCESS ;

 S BATCNT=0

 W !!,"Please be patient while I populate the asthma register, this could take",!,"anywhere from 10 minutes to an hour depending on the size of your patient",!,"database.",!

 S BATB=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-365))

 S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="N" KILL DA D ^DIR KILL DIR

 I $D(DIRUT) D EOJ Q

 I 'Y D EOJ Q

 S BATE=$$FMTE^XLFDT(DT)

 S BATDFN=0 F  S BATDFN=$O(^DPT(BATDFN)) Q:BATDFN'=+BATDFN  D

 .Q:$P(^DPT(BATDFN,0),U,19)

 .S BATAGE=$$AGE^AUPNPAT(BATDFN)

 .I $D(BATAGET),BATAGE>$P(BATAGET,"-",2) Q

 .I $D(BATAGET),BATAGE<$P(BATAGET,"-") Q

 .Q:$$DOD^AUPNPAT(BATDFN)]""

 .I $D(BATCOMM) S C=$P($G(^AUPNPAT(BATDFN,11)),U,18) Q:C=""  I '$D(BATCOMM(C)) Q

 .Q:'$$AST2(BATDFN,BATB,BATE)

 .D ^XBFMK

 .I $D(^BATREG(BATDFN,0)) W !,"Patient ",$P(^DPT(BATDFN,0),U)," already on Register.",! Q

 .S DIC="^BATREG(",(DINUM,X)=BATDFN,DIC(0)="L",DIC("DR")=".02////U",DLAYGO=90181.01,DIADD=1 K DD,DO D FILE^DICN K DIC,DLAYGO,DIADD,DINUM

 .I Y=-1 W !,"error uploading patient dfn ",BATDFN,!

 .S BATCNT=BATCNT+1

 .W ".",BATCNT

 W !!,BATCNT," patients were added to the asthma register."

 D PAUSE

EOJ ;

 K DIR

 D EN^XBVK("BAT")

 Q

PAUSE ;EP

 S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 Q

AST2(P,B,E) ;EP - return date of last asthma diagnosis

 I $G(P)="" Q 0

 NEW BATX,BATY,I,S,Q

 K BATX

 S BATY="BATX("

 S S=P_"^LAST 2 DX [BAT ASTHMA DIAGNOSES;DURING "_B_"-"_E S Q=$$START1^APCLDF(S,BATY)

 I '$D(BATX(2)) Q ""

 Q 1

BATBLG    ; IHS/CMI/LAB - ;

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

 +2       ;

 +3       ;

 +4        IF $DATA(IOF)

               WRITE @IOF

 +5        WRITE !!,"This option is used to initially populate your register with a pre-defined",!,"set of patients.  If you continue with this option your patient file will"

 +6        WRITE !,"be scanned and all patients within a [user defined] age range living in",!,"[user defined] community with at least two asthma visits (POV with",!,"ICD-9 codes 493.00-493.99) in the past year will be automatically added to the"

 +7        WRITE !,"register with a status of Unreviewed.",!!

 +8        SET DIR(0)="Y"

           SET DIR("A")="Do you want to continue"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +9        IF $DATA(DIRUT)

               DO EOJ

               QUIT 

 +10       IF 'Y

               DO EOJ

               QUIT 

COM       ;

 +1        KILL BATCOMM

 +2        SET DIR(0)="S^O:One particular Community;A:All Communities;S:Selected Set of Communities (Taxonomy)"

           SET DIR("A")="Include patients who live in"

           SET DIR("B")="O"

           KILL DA

           DO ^DIR

           KILL DIR

 +3        IF $DATA(DIRUT)

               GOTO EOJ

 +4        IF Y="A"

               WRITE !!,"Patients from all communities will be included in the report.",!

               GOTO AGE

 +5        IF Y="O"

               Begin DoDot:1

 +6                KILL BATCOMM

 +7                SET DIC="^AUTTCOM("

                   SET DIC(0)="AEMQ"

                   SET DIC("A")="Which COMMUNITY: "

                   DO ^DIC

                   KILL DIC

 +8                IF Y=-1

                       QUIT 

 +9                SET BATCOMM($PIECE(^AUTTCOM(+Y,0),U))=""

               End DoDot:1

               IF '$DATA(BATCOMM)

                   GOTO COM

               GOTO AGE

 +10       KILL BATCOMM

           SET X="COMMUNITY"

           SET DIC="^AMQQ(5,"

           SET DIC(0)="FM"

           SET DIC("S")="I $P(^(0),U,14)"

           DO ^DIC

           KILL DIC,DA

           IF Y=-1

               WRITE "OOPS - QMAN NOT CURRENT - QUITTING"

               SET BATERR=1

               QUIT 

 +11       DO ^AMQQGTX0(+Y,"BATCOMM(")

 +12       IF '$DATA(BATCOMM)

               GOTO COM

 +13       IF $DATA(BATCOMM("*"))

               KILL BATCOMM

               GOTO COM

 +14      ;

AGE       ;Age Screening

 +1        KILL BATAGE,BATAGET

 +2        WRITE !

           SET DIR(0)="YO"

           SET DIR("A")="Would you like to restrict the report by Patient age range"

           SET DIR("B")="YES"

 +3        SET DIR("?")="If you wish to include visits from ALL age ranges, anwser No.  If you wish to include visits for only patients within a particular age range, enter Yes."

 +4        DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               GOTO COM

 +6        IF 'Y

               GOTO PROCESS

 +7       ;

AGER      ;Age Screening

 +1        WRITE !

 +2        SET DIR(0)="FO^1:7"

           SET DIR("A")="Enter an Age Range (e.g. 5-12,1-1)"

           DO ^DIR

 +3        IF Y=""

               WRITE !!,"No age range entered."

               GOTO AGE

 +4        IF Y'?1.3N1"-"1.3N

               WRITE !!,$CHAR(7),$CHAR(7),"Enter a numeric range in the format nnn-nnn. e.g. 0-5, 0-99, 5-20."

               GOTO AGER

 +5        SET BATAGET=Y

 +6       ;

 +7       ;

PROCESS   ;

 +1        SET BATCNT=0

 +2        WRITE !!,"Please be patient while I populate the asthma register, this could take",!,"anywhere from 10 minutes to an hour depending on the size of your patient",!,"database.",!

 +3        SET BATB=$$FMTE^XLFDT($$FMADD^XLFDT(DT,-365))

 +4        SET DIR(0)="Y"

           SET DIR("A")="Do you want to continue"

           SET DIR("B")="N"

           KILL DA

           DO ^DIR

           KILL DIR

 +5        IF $DATA(DIRUT)

               DO EOJ

               QUIT 

 +6        IF 'Y

               DO EOJ

               QUIT 

 +7        SET BATE=$$FMTE^XLFDT(DT)

 +8        SET BATDFN=0

           FOR 

               SET BATDFN=$ORDER(^DPT(BATDFN))

               IF BATDFN'=+BATDFN

                   QUIT 

               Begin DoDot:1

 +9                IF $PIECE(^DPT(BATDFN,0),U,19)

                       QUIT 

 +10               SET BATAGE=$$AGE^AUPNPAT(BATDFN)

 +11               IF $DATA(BATAGET)

                       IF BATAGE>$PIECE(BATAGET,"-",2)

                           QUIT 

 +12               IF $DATA(BATAGET)

                       IF BATAGE<$PIECE(BATAGET,"-")

                           QUIT 

 +13               IF $$DOD^AUPNPAT(BATDFN)]""

                       QUIT 

 +14               IF $DATA(BATCOMM)

                       SET C=$PIECE($GET(^AUPNPAT(BATDFN,11)),U,18)

                       IF C=""

                           QUIT 

                       IF '$DATA(BATCOMM(C))

                           QUIT 

 +15               IF '$$AST2(BATDFN,BATB,BATE)

                       QUIT 

 +16               DO ^XBFMK

 +17               IF $DATA(^BATREG(BATDFN,0))

                       WRITE !,"Patient ",$PIECE(^DPT(BATDFN,0),U)," already on Register.",!

                       QUIT 

 +18               SET DIC="^BATREG("

                   SET (DINUM,X)=BATDFN

                   SET DIC(0)="L"

                   SET DIC("DR")=".02////U"

                   SET DLAYGO=90181.01

                   SET DIADD=1

                   KILL DD,DO

                   DO FILE^DICN

                   KILL DIC,DLAYGO,DIADD,DINUM

 +19               IF Y=-1

                       WRITE !,"error uploading patient dfn ",BATDFN,!

 +20               SET BATCNT=BATCNT+1

 +21               WRITE ".",BATCNT

               End DoDot:1

 +22       WRITE !!,BATCNT," patients were added to the asthma register."

 +23       DO PAUSE

EOJ       ;

 +1        KILL DIR

 +2        DO EN^XBVK("BAT")

 +3        QUIT 

PAUSE     ;EP

 +1        SET DIR(0)="EO"

           SET DIR("A")="Press enter to continue...."

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +2        QUIT 

AST2(P,B,E) ;EP - return date of last asthma diagnosis

 +1        IF $GET(P)=""

               QUIT 0

 +2        NEW BATX,BATY,I,S,Q

 +3        KILL BATX

 +4        SET BATY="BATX("

 +5        SET S=P_"^LAST 2 DX [BAT ASTHMA DIAGNOSES;DURING "_B_"-"_E

           SET Q=$$START1^APCLDF(S,BATY)

 +6        IF '$DATA(BATX(2))

               QUIT ""

 +7        QUIT 1