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
