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

APCLDMAP.m

Go to the documentation of this file. 
  1. APCLDMAP ; IHS/CMI/LAB - print hs for dm patients with appts ;
  1.  ;;2.0;IHS PCC SUITE;;MAY 14, 2009
  1.  ;
  1.  ;
  1.  ;this routine will go through the Diabetes Register
  1.  ;and then see if the patient has an appt, if so print health sum
  1.  ;
  1. EP ;EP - called from option interactive
  1.  D EOJ
  1.  W:$D(IOF) @IOF
  1.  W !!,"This option will print a list of all patients on a register"
  1.  W !,"e.g. Diabetes Register) who have an appointment in a date range"
  1.  W !,"in any clinic or in a selected set of clinics.",!!
  1.  W !!,"You will be asked to enter the name of the register, the date range of the"
  1.  W !,"appointments and the clinic names if selecting a set of clinics.",!
  1. REGISTER ;get register name
  1.  S APCLREG=""
  1.  W ! S DIC="^ACM(41.1,",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Register: " D ^DIC
  1.  I Y=-1 S APCLREG="" W !,"No Register Selected." G EOJ
  1.  S APCLREG=+Y
  1. DATES K APCLED,APCLBD
  1.  K DIR W ! S DIR(0)="DO^::EXP",DIR("A")="Enter Beginning Appointment Date"
  1.  D ^DIR G:Y<1 REGISTER S APCLBD=Y
  1.  K DIR S DIR(0)="DO^::EXP",DIR("A")="Enter Ending Appointment Date"
  1.  D ^DIR G:Y<1 REGISTER  S APCLED=Y
  1.  ;
  1.  I APCLED<APCLBD D  G DATES
  1.  . W !!,$C(7),"Sorry, Ending Date MUST not be earlier than Beginning Date."
  1.  S APCLSD=$$FMADD^XLFDT(APCLBD,-1)_".9999"
  1.  ;
  1. CLIN ;
  1.  S APCLCLN=""
  1.  S DIR(0)="S^A:ANY Clinic;S:One or more selected Clinics",DIR("A")="Include patients with Appointments to",DIR("B")="A" KILL DA D ^DIR KILL DIR
  1.  G:$D(DIRUT) DATES
  1.  S APCLCLN=Y
  1.  I APCLCLN="A" K APCLCLN G ZIS
  1.  ;get which clinics
  1.  K APCLCLN
  1. CLIN1 ;
  1.  W ! S DIC="^SC(",DIC(0)="AEMZQ",DIC("A")="Select CLINIC: "
  1.  S DIC("S")="I $P(^(0),U,3)=""C""" D ^DIC K DIC
  1.  I Y=-1,'$D(APCLCLN) G CLIN
  1.  I X="^" G CLIN
  1.  I Y="",$D(APCLCLN) G ZIS
  1.  I Y=-1,$D(APCLCLN) G ZIS
  1.  I X="",'$D(APCLCLN) G CLIN
  1.  S APCLCLN(+Y)=""
  1.  G CLIN1
  1. ZIS ;
  1. DEMO ;
  1.  D DEMOCHK^APCLUTL(.APCLDEMO)
  1.  I APCLDEMO=-1 G CLIN
  1.  S XBRP="PRINT^APCLDMAP",XBRC="PROC^APCLDMAP",XBRX="EOJ^APCLDMAP",XBNS="APCL"
  1.  D ^XBDBQUE
  1.  Q
  1. EOJ ;
  1.  D ^XBFMK
  1.  K DIC,DIR
  1.  D EN^XBVK("APCL")
  1.  Q
  1.  ;
  1. TEST ;
  1.  D BDMG(1,3040101,3041231,13)
  1.  Q
  1. BDMG(APCLREG,APCLBD,APCLED,APCLCLN) ;EP - GUI DMS Entry Point
  1.  ;cmi/anch/maw added 10/19/2004
  1.  S APCLSD=$$FMADD^XLFDT(APCLBD,-1)_".9999"
  1.  S APCLGUI=1
  1.  N APCLOPT,APCLNOW,APCLIEN  ;maw
  1.  S APCLOPT="List Patients on a Register w/an Appointment"
  1.  D NOW^%DTC
  1.  S APCLNOW=$G(%)
  1.  K DD,D0,DIC
  1.  S X=DUZ_$$NOW^XLFDT
  1.  S DIC("DR")=".02////"_DUZ_";.03////"_APCLNOW_";.06///"_$G(APCLOPT)_";.07////R"
  1.  S DIC="^APCLGUIR(",DIC(0)="L",DIADD=1,DLAYGO=9001004.4
  1.  D FILE^DICN
  1.  K DIADD,DLAYGO,DIC,DA
  1.  I Y=-1 S APCLIEN=-1 Q
  1.  S APCLIEN=+Y
  1.  S BDMGIEN=APCLIEN  ;cmi/maw added
  1.  D ^XBFMK
  1.  K ZTSAVE S ZTSAVE("*")=""
  1.  ;D GUIEP for interactive testing
  1.  S ZTIO="",ZTDTH=$$NOW^XLFDT,ZTRTN="GUIEP^APCLDMAP",ZTDESC="GUI DM REG APPT" D ^%ZTLOAD
  1.  D EOJ
  1.  Q
  1. GUIEP ;EP
  1.  D PROC
  1.  K ^TMP($J,"APCLDMAP")
  1.  S IOM=80
  1.  D GUIR^XBLM("PRINT^APCLDMAP","^TMP($J,""APCLDMAP"",")
  1.  S X=0,C=0 F  S X=$O(^TMP($J,"APCLDMAP",X)) Q:X'=+X  D
  1.  .S APCLDATA=^TMP($J,"APCLDMAP",X)
  1.  .I APCLDATA="ZZZZZZZ" S APCLDATA=$C(12)
  1.  .S ^APCLGUIR(APCLIEN,11,X,0)=APCLDATA,C=C+1
  1.  S ^APCLGUIR(APCLIEN,11,0)="^^"_C_"^"_C_"^"_DT_"^"
  1.  S DA=APCLIEN,DIK="^APCLGUIR(" D IX1^DIK
  1.  D ENDLOG
  1.  K ^TMP($J,"APCLDMAP")
  1.  S ZTREQ="@"
  1.  Q
  1.  ;
  1. ENDLOG ;-- write the end of the log
  1.  D NOW^%DTC
  1.  S APCLNOW=$G(%)
  1.  S DIE="^APCLGUIR(",DA=APCLIEN,DR=".04////"_APCLNOW_";.07////C"
  1.  D ^DIE
  1.  K DIE,DR,DA
  1.  Q
  1.  ;
  1. PROC ;
  1.  S APCLJ=$J,APCLH=$H
  1.  S ^XTMP("APCLDMAP",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"REGISTER PTS WITH APPT"
  1.  S APCLDMX=0 F  S APCLDMX=$O(^ACM(41,"B",APCLREG,APCLDMX)) Q:APCLDMX'=+APCLDMX  D
  1.  .;check to see if patient has an appt
  1.  .S DFN=$P(^ACM(41,APCLDMX,0),U,2)
  1.  .Q:$$DEMO^APCLUTL(DFN,$G(APCLDEMO))
  1.  .S APCLDMY=APCLSD F  S APCLDMY=$O(^DPT(DFN,"S",APCLDMY)) Q:APCLDMY=""!($P(APCLDMY,".")>APCLED)  D
  1.  ..I $P(^DPT(DFN,"S",APCLDMY,0),U,2)["C" Q  ;cancelled
  1.  ..I $D(APCLCLN) S X=$P(^DPT(DFN,"S",APCLDMY,0),U) I '$D(APCLCLN(X)) Q  ;not a clinic of interest
  1.  ..S ^XTMP("APCLDMAP",APCLJ,APCLH,"APPTS",DFN,APCLDMY,$P(^DPT(DFN,"S",APCLDMY,0),U))=""
  1.  ..Q
  1.  .Q
  1.  Q
  1. DONE ;
  1.  I $E(IOST)="C",IO=IO(0) S DIR(0)="EO",DIR("A")="End of report.  PRESS ENTER" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  W:$D(IOF) @IOF
  1.  K APCLTS,APCLS,APCLM,APCLET
  1.  K ^XTMP("APCLDMAP",APCLJ,APCLH),APCLJ,APCLH
  1.  Q
  1.  ;
  1. PRINT ;EP - called from xbdbque
  1.  S APCLIOSL=$S($G(APCLGUI):55,1:IOSL)
  1.  K APCLQ S APCLPG=0 D HEADER
  1.  I '$D(^XTMP("APCLDMAP",APCLJ,APCLH)) W !!,"NO DATA TO REPORT",! G DONE
  1.  S DFN=0 F  S DFN=$O(^XTMP("APCLDMAP",APCLJ,APCLH,"APPTS",DFN)) Q:DFN'=+DFN!($D(APCLQ))  D
  1.  .S APCLD=0 F  S APCLD=$O(^XTMP("APCLDMAP",APCLJ,APCLH,"APPTS",DFN,APCLD)) Q:APCLD'=+APCLD!($D(APCLQ))  D
  1.  ..S APCLC=0 F  S APCLC=$O(^XTMP("APCLDMAP",APCLJ,APCLH,"APPTS",DFN,APCLD,APCLC)) Q:APCLC'=+APCLC!($D(APCLQ))  D
  1.  ...I $Y>(APCLIOSL-4) D HEADER Q:$D(APCLQ)
  1.  ...W !,$$HRN^AUPNPAT(DFN,DUZ(2)),?7,$E($P(^DPT(DFN,0),U),1,25),?38,$E($P(^SC(APCLC,0),U),1,20),?59,$$FMTE^XLFDT($P(APCLD,".")),?72,$P($$FMTE^XLFDT(APCLD,"2P")," ",2)
  1.  D DONE
  1.  Q
  1.  G:'APCLPG HEADER1
  1.  K DIR I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQ="" Q
  1. HEADER1 ;
  1.  W:$D(IOF) @IOF S APCLPG=APCLPG+1
  1.  I $G(APCLGUI),APCLPG'=1 W !,"ZZZZZZZ"
  1.  W !?3,$P(^VA(200,DUZ,0),U,2),?35,$$FMTE^XLFDT(DT),?70,"Page ",APCLPG,!
  1.  W !,$$CTR("PATIENTS ON THE "_$P(^ACM(41.1,APCLREG,0),U)_" REGISTER WITH AN APPOINTMENT",80),!
  1.  S X="Appointment Dates: "_$$FMTE^XLFDT(APCLBD)_" to "_$$FMTE^XLFDT(APCLED) W $$CTR(X,80),!
  1.  W $$CTR("CLINICS: "_$S($D(APCLCLN):"USER SELECTED",1:"ANY"),80),!
  1.  W !,"HRN",?7,"PATIENT NAME",?38,"CLINIC NAME",?59,"DATE",?72,"TIME"
  1.  W !,$TR($J("",80)," ","-")
  1.  Q
  1. CTR(X,Y) ;EP - Center X in a field Y wide.
  1.  Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
  1.  ;----------
  1. EOP ;EP - End of page.
  1.  Q:$E(IOST)'="C"
  1.  Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
  1.  NEW DIR
  1.  K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
  1.  S DIR("A")="End of report.  Press Enter",DIR(0)="E" D ^DIR
  1.  Q
  1.  ;----------
  1. USR() ;EP - Return name of current user from ^VA(200.
  1.  Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
  1.  ;----------
  1. LOC() ;EP - Return location name from file 4 based on DUZ(2).
  1.  Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
  1.  ;----------
  1. POST ;
  1.  NEW X
  1.  S X=$$ADD^XPDMENU("APCL M MAIN DM MENU","APCL DM REG APPT CLN","APCL")
  1.  I 'X W "Attempt to new appt list of reg pats failed.." H 3
  1.  Q