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

APCLDMSM.m

Go to the documentation of this file. 
  1. APCLDMSM ; IHS/CMI/LAB - print Self Monitoring Pts for dm patients ;
  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 Self Monitoring Glucose Health Factor
  1.  ;
  1. EP ;EP - called from option interactive
  1.  D EOJ
  1.  W:$D(IOF) @IOF
  1.  W !!,"This option will provide a list of patients on a register"
  1.  W !,"(e.g. IHS Diabetes) that either are doing Self Monitoring of"
  1.  W !,"Glucose or who are not doing Self Monitoring of Glucose."
  1.  W !,"The following definitions/logic is used:"
  1.  W !?5,"Yes, Doing self monitoring:"
  1.  W !?7,"- the last health factor documented in the 365 days prior to the"
  1.  W !?7,"end date is SELF MONITORING BLOOD GLUCOSE-YES"
  1.  W !?7,"- the patient has had strips dispensed through pharmacy in "
  1.  W !?7,"the 365 days prior to the end date."
  1.  W !?5,"No, not doing self monitoring"
  1.  W !?7,"- the last health factor documented in the 365 days prior to"
  1.  W !?7,"the end date is SELF MONITORING BLOOD GLUCOSE-NO or SELF MONITORING"
  1.  W !?7,"BLOOD GLUCOSE-REFUSED"
  1.  W !?7,"- the patient has had no strips dispensed through pharmacy"
  1.  W !?7,"- the patient has had neither strips dispensed nor a health"
  1.  W !?7,"factor documented in the 365 days prior to the end date"
  1.  W !!,"In the case of the following conflict:  the patient's last"
  1.  W !,"health factor states NO or REFUSED but they have had strips"
  1.  W !,"dispensed they will show up on each report with a status of"
  1.  W !,"Maybe."
  1.  ;W !!,"This option will print a list of all patients on a register"
  1.  ;W !,"(e.g. Diabetes Register) who have a Health Factor "
  1.  ;W !,"for SELF MONITORING BLOOD GLUCOSE.",!!
  1.  ;W "You will be asked to enter the name of the register & the date range of the"
  1.  ;W !,"Visits.  The Report will Display YES or NO or REFUSED Self Monitoring",!
  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.  ;get status
  1.  S APCLSTAT=""
  1.  S DIR(0)="Y",DIR("A")="Do you want to select register patients with a particular status",DIR("B")="Y" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G REGISTER
  1.  I Y=0 S APCLSTAT="" G REPORT
  1.  ;which status
  1.  S DIR(0)="9002241,1",DIR("A")="Which status",DIR("B")="A" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G REGISTER
  1.  S APCLSTAT=Y
  1. REPORT ;
  1.  S APCLRPT=""
  1.  S DIR(0)="S^Y:YES, Doing Self Monitoring;N:NO, Not doing Self Monitoring;B:Both",DIR("A")="What list of patients do you want",DIR("B")="N" K DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G REGISTER
  1.  S APCLRPT=Y
  1. ENDDATE ;
  1.  S APCLED=""
  1.  W !!,"Enter the end date to use in calculating the 365 day time period."
  1.  S DIR(0)="D^::EPX",DIR("A")="Enter the End Date" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G REPORT
  1.  S APCLED=Y
  1. SORTED ;
  1.  K DIR S DIR(0)="SO^H:HRN;P:PATIENT NAME;C:COMMUNITY OF RESIDENCE",DIR("A")="How would you like the report sorted",DIR("B")="H" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G ENDDATE
  1.  S APCLSORT=Y
  1. ZIS ;
  1. DEMO ;
  1.  D DEMOCHK^APCLUTL(.APCLDEMO)
  1.  I APCLDEMO=-1 G SORTED
  1.  S XBRP="PRINT^APCLDMSM",XBRC="PROC^APCLDMSM",XBRX="EOJ^APCLDMSM",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. PROC ;
  1.  K ^XTMP("APCLDMSM")
  1.  S APCLJ=$J,APCLH=$H
  1.  S ^XTMP("APCLDMSM",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"REGISTER PTS WITH SELF MONITORING"
  1.  S APCLDMX=0 F  S APCLDMX=$O(^ACM(41,"B",APCLREG,APCLDMX)) Q:APCLDMX'=+APCLDMX  D
  1.  .;check to see if patient has Self Monitoring or not
  1.  .;check register status
  1.  .I APCLSTAT]"",$P($G(^ACM(41,APCLDMX,"DT")),U,1)'=APCLSTAT Q
  1.  .S DFN=$P(^ACM(41,APCLDMX,0),U,2)
  1.  .Q:$$DEMO^APCLUTL(DFN,$G(APCLDEMO))
  1.  .Q:$$DOD^AUPNPAT(DFN)]""  ;don't display deceased patients
  1.  .S APCLHF=$$LASTHF(DFN,"DIABETES SELF MONITORING",$$FMADD^XLFDT(APCLED,-365),"B")
  1.  .I APCLHF["YES" S APCLHFG=1
  1.  .I APCLHF="" S APCLHFG=""
  1.  .I APCLHF["NO" S APCLHFG=0
  1.  .I APCLHF["REFUSE" S APCLHFG=0
  1.  .K APCLMED
  1.  .S X=DFN_"^MEDS [DM AUDIT SELF MONITOR DRUGS"_";DURING "_$$FMADD^XLFDT(APCLED,-365)_"-"_APCLED S E=$$START1^APCLDF(X,"APCLMED(")
  1.  .I $D(APCLMED(1)) S APCLMEDG=1
  1.  .I '$D(APCLMED(1)) S APCLMEDG=0
  1.  .D SETVAL
  1.  .I APCLRPT="Y",APCLVAL="N" Q
  1.  .I APCLRPT="N",APCLVAL="Y" Q
  1.  .S ^XTMP("APCLDMSM",APCLJ,APCLH,"SELF",$$SORT(DFN,APCLSORT),DFN)=APCLHF_"||"_$G(APCLMED(1))_"||"_APCLVAL
  1.  .Q
  1.  Q
  1. SORT(P,APCLSORT) ;
  1.  NEW X S X=""
  1.  I APCLSORT="H" S X=$$HRN^AUPNPAT(P,DUZ(2))
  1.  I APCLSORT="P" S X=$P(^DPT(P,0),U)
  1.  I APCLSORT="C" S X=$$COMMRES^AUPNPAT(P)
  1.  I X="" S X="----"
  1.  Q X
  1. SETVAL ;
  1.  S APCLVAL=""
  1.  I APCLMEDG=1,APCLHFG=1 S APCLVAL="Y" Q
  1.  I APCLMEDG=1,APCLHFG="" S APCLVAL="Y" Q
  1.  I APCLMEDG=1,APCLHFG=0 S APCLVAL="M" Q
  1.  I APCLHFG=1 S APCLVAL="Y" Q
  1.  I APCLHFG=0 S APCLVAL="N" Q
  1.  I APCLHFG="" S APCLVAL="N" 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("APCLDMSM",APCLJ,APCLH),APCLJ,APCLH
  1.  Q
  1.  ;
  1. PRINT ;EP - called from xbdbque
  1.  K APCLQ S APCLPG=0 D HEADER
  1.  I '$D(^XTMP("APCLDMSM",APCLJ,APCLH)) W !!,"NO DATA TO REPORT",! G DONE
  1.  S APCLSV="" F  S APCLSV=$O(^XTMP("APCLDMSM",APCLJ,APCLH,"SELF",APCLSV)) Q:APCLSV=""!($D(APCLQ))  D
  1.  .S DFN=0 F  S DFN=$O(^XTMP("APCLDMSM",APCLJ,APCLH,"SELF",APCLSV,DFN)) Q:DFN'=+DFN!($D(APCLQ))  D
  1.  ..I $Y>(IOSL-4) D HEADER Q:$D(APCLQ)
  1.  ..I APCLRPT="Y" W !
  1.  ..W !,$$HRN^AUPNPAT(DFN,DUZ(2)),?7,$E($P(^DPT(DFN,0),U),1,28),?38,$E($$COMMRES^AUPNPAT(DFN,"E"),1,15),?54,$$LASTVD^APCLV1(DFN,"E")
  1.  ..S APCLVAL=$P(^XTMP("APCLDMSM",APCLJ,APCLH,"SELF",APCLSV,DFN),"||",3)
  1.  ..S APCLMED=$P(^XTMP("APCLDMSM",APCLJ,APCLH,"SELF",APCLSV,DFN),"||",2)
  1.  ..S APCLHF=$P(^XTMP("APCLDMSM",APCLJ,APCLH,"SELF",APCLSV,DFN),"||",1)
  1.  ..S X="",APCLLHF="",APCLLMED=""
  1.  ..I APCLVAL="Y" S X="Yes"
  1.  ..I APCLVAL="N" S X="No"
  1.  ..I APCLVAL="M" S X="Maybe"
  1.  ..;I APCLHF="",APCLMED="" S APCLLHF="Not documented" G PRINT1
  1.  ..S APCLLHF=APCLHF
  1.  ..S APCLLMED=$P(APCLMED,U,2)_$S($P(APCLMED,U,2)]"":" on ",1:"")_$$FMTE^XLFDT($P(APCLMED,U),2)
  1. PRINT1 ..W ?75,X
  1.  ..I APCLLHF]"" W !?3,"Health Factor: ",APCLLHF
  1.  ..I APCLLMED]"" W !?3,"Medication Dispensed: ",APCLLMED
  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.  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 - BLOOD GLUCOSE SELF MONITORING",80),!
  1.  I APCLRPT="Y" W $$CTR("Patients Doing Self Monitoring",80),!
  1.  I APCLRPT="N" W $$CTR("Patients NOT Doing Self Monitoring",80),!
  1.  I APCLRPT="B" W $$CTR("List of Patients w/Self Monitoring of Blood Glucose Status",80),!
  1.  S X="End Date: "_$$FMTE^XLFDT(APCLED) W $$CTR(X,80),!
  1.  W !,"HRN",?7,"PATIENT NAME",?38,"COMMUNITY",?54,"LAST VISIT",?75,"SMBG?"
  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
  1. LASTHF(P,C,BDATE,F) ;EP - get last factor in category C for patient P
  1.  I '$G(P) Q ""
  1.  I $G(C)="" Q ""
  1.  I $G(F)="" S F=""
  1.  S C=$O(^AUTTHF("B",C,0)) ;ien of category passed
  1.  I '$G(C) Q ""
  1.  NEW H,D,O S H=0 K O
  1.  F  S H=$O(^AUTTHF("AC",C,H))  Q:'+H  D
  1.  .  Q:'$D(^AUPNVHF("AA",P,H))
  1.  .  S D=$O(^AUPNVHF("AA",P,H,""))
  1.  .  Q:'D
  1.  .  Q:(9999999-D)<BDATE
  1.  .  S O(D)=$O(^AUPNVHF("AA",P,H,D,""))
  1.  .  Q
  1.  S D=$O(O(0))
  1.  I D="" Q D
  1.  I F="N" Q $$VAL^XBDIQ1(9000010.23,O(D),.01)
  1.  I F="S" Q $P($G(^AUPNVHF(O(D),0)),U,6)
  1.  I F="B" Q $$VAL^XBDIQ1(9000010.23,O(D),.01)_" "_$$FMTE^XLFDT((9999999-D),2)
  1.  Q 9999999-D