Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BATREG

BATREG.m

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