BATREG ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;
;;1.0;IHS ASTHMA REGISTER;;FEB 19, 2003
;
;
A ;EP;add/edit register patient
K DIC
W:$D(IOF) @IOF
W !!,$$CTR^BATU("Update Asthma Register Data")
W !!,"This option is used to either Add a new patient to the Asthma register or to",!,"update an existing patient.",!!
S DIC="^BATREG(",DIC(0)="AEMQL" D ^DIC
I Y=-1 D EXIT Q
S DFN=+Y
W !
S DA=DFN,DIE="^BATREG(",DR=".02;.06;.07;.08;.12;W !;1100" D ^DIE
W !! S DIR(0)="Y",DIR("A")="Do you want to update/add another patient",DIR("B")="Y" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EXIT Q
I 'Y D EXIT Q
G A
Q
AI ;EP - update status only
K DIC
W:$D(IOF) @IOF
W !!,$$CTR^BATU("Update Asthma Register Data")
W !!,"This option is used to update the STATUS field of a patient in the register",!
S DIC="^BATREG(",DIC(0)="AEMQ" D ^DIC
I Y=-1 D EXIT Q
S DFN=+Y
W !
S DA=DFN,DIE="^BATREG(",DR=".02" D ^DIE
D EXIT
Q
EXIT ;
D EN^XBVK("BAT")
D ^XBFMK
K DIADD,DLAYGO,DINUM
Q
;
EP(BATDFN,BATVIEN,BATVSIT) ;EP;entry point from APCD AST templates
I '$G(BATDFN) Q
D EN^XBNEW("EP1^BATREG","BATDFN;BATVIEN;BATVSIT")
Q
EP1 ;
;check to see if on register, if not add them and send bulletin
I $P($G(^BATSITE(DUZ(2),0)),U,7)'=1 Q ;site parameter is off or blank
S BATQUIT=""
;Q:$$LASTSEV^BATU(BATDFN)="" ;no severity
;Q:$$LASTSEV^BATU(BATDFN)=1 ;severity is 1 do not add
I '$D(^BATREG(BATDFN)) D EPADD I BATQUIT D EXIT Q
;update .05
S BATVST=$$LASTAV^BATU(BATDFN,1)
S BATSTAT=$P(^BATREG(BATDFN,0),U,2) ;status
I BATSTAT="I" S BATSTAT="U"
S DIE="^BATREG(",DR=".02///"_BATSTAT_";.05////"_BATVST,DA=BATDFN D ^DIE
I $D(Y) W !!,"Unable to update ASTHMA REGISTER. Notify Site Manager.",!
Q
EPADD ;
;I $P($G(^BATSITE(DUZ(2),0)),U,2)=0 S BATQUIT=1 Q ;do not add anyone to the register
I $P($G(^BATSITE(DUZ(2),0)),U,2)]"",$$AGE^AUPNPAT(BATDFN)>$P($G(^BATSITE(DUZ(2),0)),U,2) S BATQUIT=1 Q
I $P($G(^BATSITE(DUZ(2),0)),U,6)]"",$$AGE^AUPNPAT(BATDFN)<$P($G(^BATSITE(DUZ(2),0)),U,6) S BATQUIT=1 Q
I $P($G(^BATSITE(DUZ(2),0)),U,3)=0,$G(BATVIEN),$G(BATVSIT),$$FIRSTAP(BATDFN,BATVIEN,BATVSIT) S BATQUIT=1 Q
S (DINUM,X)=BATDFN,DIC(0)="L",DIC="^BATREG(",DIC("DR")=".02///U",DLAYGO=90181.01,DIADD=1 K DD,DO D FILE^DICN K DINUM,DLAYGO,DIADD
I Y=-1 S BATQUIT=1 Q
;send bulletin
K XMB
S XMB(1)=$P(^DPT(BATDFN,0),U),XMB(2)=$$DOB^AUPNPAT(BATDFN,"E"),XMB(3)=$$HRN^AUPNPAT(BATDFN,DUZ(2)),XMB(4)=$$VAL^XBDIQ1(9000010.41,BATDFN,.03),XMB(5)=$$LASTSEV^BATU(BATDFN,5)
S XMB="BAT NEW PATIENT ON REGISTER",BATDUZ=DUZ,DUZ=.5
D ^XMB S DUZ=BATDUZ K XMB
Q
UPLOAD ;EP - called from option to upload patients from search template
W:$D(IOF) @IOF
UPL1 D EXIT
W !!,$$CTR^BATU("Upload Patients into Asthma Register from Template",80)
W !!,"This option is used to upload a group of patients from a template into the ",!,"Asthma Register. You should have created a template using a utility such as",!,"QMAN.",!!
TEMP ;get template
S BATTEMP=""
W ! S DIC("S")="I $P(^(0),U,4)=9000001" S DIC="^DIBT(",DIC("A")="Enter Patient SEARCH TEMPLATE name: ",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DICR
I Y=-1 D EXIT Q
S BATTEMP=+Y
;
WSTAT ;
S BATSTAT=""
W !!,"What status should be assigned to the patients when they are uploaded.",!
S DIR(0)="90181.01,.02",DIR("A")="Enter Status to be used",DIR("B")="U" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G UPL1
S BATSTAT=Y,BATSTAT(0)=Y(0)
CONT ;
S X=0,C=0 F S X=$O(^DIBT(BATTEMP,1,X)) Q:X'=+X S C=C+1
W !!,"A total of ",C," patients will be uploaded with a status of ",BATSTAT(0),".",!
S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EXIT Q
I 'Y D EXIT Q
UPL2 ;process uploading
W !
S BATDFN=0,BATCNT=0 F S BATDFN=$O(^DIBT(BATTEMP,1,BATDFN)) Q:BATDFN'=+BATDFN D
.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////"_BATSTAT,DLAYGO=90181.01,DIADD=1 K DD,DO D FILE^DICN K DIC,DLAYGO,DIADD,DINUM K DIC
.I Y=-1 W !,"error uploading patient dfn ",BATDFN,!
.S BATCNT=BATCNT+1
.W ".",BATCNT
.Q
W !!,"A total of ",BATCNT," patients were uploaded into the Asthma Register.",!
D PAUSE
D EXIT
Q
PAUSE ;EP
S DIR(0)="EO",DIR("A")="Press enter to continue...." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
Q
FIRSTAP(P,VIEN,VSIT) ;
I $G(P)="" Q 0
I $G(VSIT)="" Q 0
I $G(VIEN)="" Q 0
NEW BATX,BATY,I,S,E
K BATX
S BATY="BATX("
S S=P_"^FIRST DX [BAT ASTHMA DIAGNOSES" S E=$$START1^APCLDF(S,BATY)
I E Q 0
I $D(BATX(1)) Q 0
Q 1
SITE ;EP - update site parameters
W:$D(IOF) @IOF W !!,$$CTR^BATU("Update Site Parameters"),!
K DIC S DIC="^BATSITE(",DIC(0)="AEMQL",DIC("B")=$P(^DIC(4,DUZ(2),0),U) D ^DIC
I Y=-1 D ^XBFMK Q
S DA=+Y,DIE="^BATSITE(",DR="[BAT UPDATE SITE PARAMETERS]" D ^DIE
D ^XBFMK
Q
BATREG ; IHS/CMI/LAB - NO DESCRIPTION PROVIDED ;
+1 ;;1.0;IHS ASTHMA REGISTER;;FEB 19, 2003
+2 ;
+3 ;
A ;EP;add/edit register patient
+1 KILL DIC
+2 IF $DATA(IOF)
WRITE @IOF
+3 WRITE !!,$$CTR^BATU("Update Asthma Register Data")
+4 WRITE !!,"This option is used to either Add a new patient to the Asthma register or to",!,"update an existing patient.",!!
+5 SET DIC="^BATREG("
SET DIC(0)="AEMQL"
DO ^DIC
+6 IF Y=-1
DO EXIT
QUIT
+7 SET DFN=+Y
+8 WRITE !
+9 SET DA=DFN
SET DIE="^BATREG("
SET DR=".02;.06;.07;.08;.12;W !;1100"
DO ^DIE
+10 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Do you want to update/add another patient"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
DO EXIT
QUIT
+12 IF 'Y
DO EXIT
QUIT
+13 GOTO A
+14 QUIT
AI ;EP - update status only
+1 KILL DIC
+2 IF $DATA(IOF)
WRITE @IOF
+3 WRITE !!,$$CTR^BATU("Update Asthma Register Data")
+4 WRITE !!,"This option is used to update the STATUS field of a patient in the register",!
+5 SET DIC="^BATREG("
SET DIC(0)="AEMQ"
DO ^DIC
+6 IF Y=-1
DO EXIT
QUIT
+7 SET DFN=+Y
+8 WRITE !
+9 SET DA=DFN
SET DIE="^BATREG("
SET DR=".02"
DO ^DIE
+10 DO EXIT
+11 QUIT
EXIT ;
+1 DO EN^XBVK("BAT")
+2 DO ^XBFMK
+3 KILL DIADD,DLAYGO,DINUM
+4 QUIT
+5 ;
EP(BATDFN,BATVIEN,BATVSIT) ;EP;entry point from APCD AST templates
+1 IF '$GET(BATDFN)
QUIT
+2 DO EN^XBNEW("EP1^BATREG","BATDFN;BATVIEN;BATVSIT")
+3 QUIT
EP1 ;
+1 ;check to see if on register, if not add them and send bulletin
+2 ;site parameter is off or blank
IF $PIECE($GET(^BATSITE(DUZ(2),0)),U,7)'=1
QUIT
+3 SET BATQUIT=""
+4 ;Q:$$LASTSEV^BATU(BATDFN)="" ;no severity
+5 ;Q:$$LASTSEV^BATU(BATDFN)=1 ;severity is 1 do not add
+6 IF '$DATA(^BATREG(BATDFN))
DO EPADD
IF BATQUIT
DO EXIT
QUIT
+7 ;update .05
+8 SET BATVST=$$LASTAV^BATU(BATDFN,1)
+9 ;status
SET BATSTAT=$PIECE(^BATREG(BATDFN,0),U,2)
+10 IF BATSTAT="I"
SET BATSTAT="U"
+11 SET DIE="^BATREG("
SET DR=".02///"_BATSTAT_";.05////"_BATVST
SET DA=BATDFN
DO ^DIE
+12 IF $DATA(Y)
WRITE !!,"Unable to update ASTHMA REGISTER. Notify Site Manager.",!
+13 QUIT
EPADD ;
+1 ;I $P($G(^BATSITE(DUZ(2),0)),U,2)=0 S BATQUIT=1 Q ;do not add anyone to the register
+2 IF $PIECE($GET(^BATSITE(DUZ(2),0)),U,2)]""
IF $$AGE^AUPNPAT(BATDFN)>$PIECE($GET(^BATSITE(DUZ(2),0)),U,2)
SET BATQUIT=1
QUIT
+3 IF $PIECE($GET(^BATSITE(DUZ(2),0)),U,6)]""
IF $$AGE^AUPNPAT(BATDFN)<$PIECE($GET(^BATSITE(DUZ(2),0)),U,6)
SET BATQUIT=1
QUIT
+4 IF $PIECE($GET(^BATSITE(DUZ(2),0)),U,3)=0
IF $GET(BATVIEN)
IF $GET(BATVSIT)
IF $$FIRSTAP(BATDFN,BATVIEN,BATVSIT)
SET BATQUIT=1
QUIT
+5 SET (DINUM,X)=BATDFN
SET DIC(0)="L"
SET DIC="^BATREG("
SET DIC("DR")=".02///U"
SET DLAYGO=90181.01
SET DIADD=1
KILL DD,DO
DO FILE^DICN
KILL DINUM,DLAYGO,DIADD
+6 IF Y=-1
SET BATQUIT=1
QUIT
+7 ;send bulletin
+8 KILL XMB
+9 SET XMB(1)=$PIECE(^DPT(BATDFN,0),U)
SET XMB(2)=$$DOB^AUPNPAT(BATDFN,"E")
SET XMB(3)=$$HRN^AUPNPAT(BATDFN,DUZ(2))
SET XMB(4)=$$VAL^XBDIQ1(9000010.41,BATDFN,.03)
SET XMB(5)=$$LASTSEV^BATU(BATDFN,5)
+10 SET XMB="BAT NEW PATIENT ON REGISTER"
SET BATDUZ=DUZ
SET DUZ=.5
+11 DO ^XMB
SET DUZ=BATDUZ
KILL XMB
+12 QUIT
UPLOAD ;EP - called from option to upload patients from search template
+1 IF $DATA(IOF)
WRITE @IOF
UPL1 DO EXIT
+1 WRITE !!,$$CTR^BATU("Upload Patients into Asthma Register from Template",80)
+2 WRITE !!,"This option is used to upload a group of patients from a template into the ",!,"Asthma Register. You should have created a template using a utility such as",!,"QMAN.",!!
TEMP ;get template
+1 SET BATTEMP=""
+2 WRITE !
SET DIC("S")="I $P(^(0),U,4)=9000001"
SET DIC="^DIBT("
SET DIC("A")="Enter Patient SEARCH TEMPLATE name: "
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA,DR,DICR
+3 IF Y=-1
DO EXIT
QUIT
+4 SET BATTEMP=+Y
+5 ;
WSTAT ;
+1 SET BATSTAT=""
+2 WRITE !!,"What status should be assigned to the patients when they are uploaded.",!
+3 SET DIR(0)="90181.01,.02"
SET DIR("A")="Enter Status to be used"
SET DIR("B")="U"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
GOTO UPL1
+5 SET BATSTAT=Y
SET BATSTAT(0)=Y(0)
CONT ;
+1 SET X=0
SET C=0
FOR
SET X=$ORDER(^DIBT(BATTEMP,1,X))
IF X'=+X
QUIT
SET C=C+1
+2 WRITE !!,"A total of ",C," patients will be uploaded with a status of ",BATSTAT(0),".",!
+3 SET DIR(0)="Y"
SET DIR("A")="Do you wish to continue"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+4 IF $DATA(DIRUT)
DO EXIT
QUIT
+5 IF 'Y
DO EXIT
QUIT
UPL2 ;process uploading
+1 WRITE !
+2 SET BATDFN=0
SET BATCNT=0
FOR
SET BATDFN=$ORDER(^DIBT(BATTEMP,1,BATDFN))
IF BATDFN'=+BATDFN
QUIT
Begin DoDot:1
+3 DO ^XBFMK
+4 IF $DATA(^BATREG(BATDFN,0))
WRITE !,"Patient ",$PIECE(^DPT(BATDFN,0),U)," already on Register.",!
QUIT
+5 SET DIC="^BATREG("
SET (DINUM,X)=BATDFN
SET DIC(0)="L"
SET DIC("DR")=".02////"_BATSTAT
SET DLAYGO=90181.01
SET DIADD=1
KILL DD,DO
DO FILE^DICN
KILL DIC,DLAYGO,DIADD,DINUM
KILL DIC
+6 IF Y=-1
WRITE !,"error uploading patient dfn ",BATDFN,!
+7 SET BATCNT=BATCNT+1
+8 WRITE ".",BATCNT
+9 QUIT
End DoDot:1
+10 WRITE !!,"A total of ",BATCNT," patients were uploaded into the Asthma Register.",!
+11 DO PAUSE
+12 DO EXIT
+13 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
FIRSTAP(P,VIEN,VSIT) ;
+1 IF $GET(P)=""
QUIT 0
+2 IF $GET(VSIT)=""
QUIT 0
+3 IF $GET(VIEN)=""
QUIT 0
+4 NEW BATX,BATY,I,S,E
+5 KILL BATX
+6 SET BATY="BATX("
+7 SET S=P_"^FIRST DX [BAT ASTHMA DIAGNOSES"
SET E=$$START1^APCLDF(S,BATY)
+8 IF E
QUIT 0
+9 IF $DATA(BATX(1))
QUIT 0
+10 QUIT 1
SITE ;EP - update site parameters
+1 IF $DATA(IOF)
WRITE @IOF
WRITE !!,$$CTR^BATU("Update Site Parameters"),!
+2 KILL DIC
SET DIC="^BATSITE("
SET DIC(0)="AEMQL"
SET DIC("B")=$PIECE(^DIC(4,DUZ(2),0),U)
DO ^DIC
+3 IF Y=-1
DO ^XBFMK
QUIT
+4 SET DA=+Y
SET DIE="^BATSITE("
SET DR="[BAT UPDATE SITE PARAMETERS]"
DO ^DIE
+5 DO ^XBFMK
+6 QUIT
