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

APCHPWHR.m

Go to the documentation of this file. 
  1. APCHPWHR ; IHS/CMI/LAB - PCC HEALTH SUMMARY ; 
  1.  ;;2.0;IHS PCC SUITE;**7,11**;MAY 14, 2009;Build 58
  1.  ;
  1.  W:$D(IOF) @IOF
  1.  W !!,"This report will tally the number of Patient Wellness Handouts given to"
  1.  W !,"patients.  The user will be able to tally based on handout type, location"
  1.  W !,"date the handout was generated and user/provider who generated the handout."
  1.  W !,"Optionally, the user can produce a list of patients receiving the handout."
  1.  W !!
  1.  S APCHJ=$J,APCHH=$H
  1. GETDATES ;
  1. BD ;get beginning date
  1.  W ! K DIR S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Date of Patient Wellness Handout" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) D EXIT Q
  1.  S APCHBD=Y
  1. ED ;get ending date
  1.  W ! S DIR(0)="DA^"_APCHBD_":DT:EP",DIR("A")="Enter ending date of Patient Wellness Handout:  " S Y=APCHBD D DD^%DT S Y="" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) G BD
  1.  S APCHED=Y
  1.  S X1=APCHBD,X2=-1 D C^%DTC S APCHSD=X
  1.  ;
  1. TYPE ;
  1.  K APCHTYPE
  1.  W ! S DIR(0)="Y",DIR("A")="Do you wish to run the report for a particular patient handout",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G GETDATES
  1.  I 'Y G LOCT
  1. TYPE1 ;
  1.  W ! S DIC="^APCHPWHT(",DIC("A")="Enter Patient Wellness Type: ",DIC(0)="AEMQ" D ^DIC
  1.  I Y=-1,'$D(APCHTYPE) W !,"No handout types selected." G TYPE
  1.  I Y=-1,$D(APCHTYPE) G LOCT
  1.  S APCHTYPE(+Y)=""
  1.  G TYPE1
  1. LOCT ;
  1.  K APCHLOCT
  1.  W ! S DIR(0)="Y",DIR("A")="Do you wish to run the report for a particular location",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G TYPE
  1.  I Y=0 D  G PROVT
  1.  .K APCHLOCT
  1. LOCT1 ;
  1.  W ! S DIC="^AUTTLOC(",DIC("A")="Enter Location: ",DIC(0)="AEMQ" D ^DIC K DIC
  1.  I Y=-1,'$D(APCHLOCT) W !,"No locations selected." G TYPE
  1.  I Y=-1,$D(APCHLOCT) G PROVT
  1.  S APCHLOCT(+Y)=""
  1.  G LOCT1
  1. PROVT ;
  1.  ;
  1.  K APCHPRVT
  1.  W ! S DIR(0)="Y",DIR("A")="Do you wish to run the report for a particular provider/user",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G LOCT
  1.  I 'Y D  G LIST
  1.  .K APCHPRVT
  1. PROVT1 ;
  1.  W ! S DIC="^VA(200,",DIC("A")="Enter Provider: ",DIC(0)="AEMQ" D ^DIC K DIC
  1.  I Y=-1,'$D(APCHPRVT) W !,"No providers selected." G LOCT
  1.  I Y=-1,$D(APCHPRVT) G LIST
  1.  S APCHPRVT(+Y)=""
  1.  G PROVT1
  1.  ;
  1. LIST ;
  1.  S APCHLIST=""
  1.  W !! S DIR(0)="Y",DIR("A")="Do you want a list of patients",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) D EXIT Q
  1.  S APCHLIST=Y
  1.  I 'APCHLIST S APCHSORT="" G ZIS
  1. SORT ;
  1.  S APCHSORT=""
  1.  S DIR(0)="S^N:Name of Patient;P:Provider/User;L:Location;T:Type of Handout;D:Date Handout Generated",DIR("A")="How do you want the list sorted"
  1.  S DIR("B")="N" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) D EXIT Q
  1.  S APCHSORT=Y
  1.  ;
  1. ZIS ;EP
  1.  D DEMOCHK^APCLUTL(.APCHDEMO)
  1.  I APCHDEMO=-1 G LIST
  1.  W !! S DIR(0)="S^P:PRINT Output;B:BROWSE Output on Screen",DIR("A")="Do you wish to",DIR("B")="P" K DA D ^DIR K DIR
  1.  I $D(DIRUT) D EXIT Q
  1.  S APCHOPT=Y
  1.  I Y="B" D BROWSE,EXIT Q
  1.  S XBRP="PRINT^APCHPWHR",XBRC="EN^APCHPWHR",XBRX="EXIT^APCHPWHR",XBNS="APCH;DFN"
  1.  D ^XBDBQUE
  1.  D EXIT1
  1.  Q
  1.  ;
  1. BROWSE ;
  1.  S XBRP="VIEWR^XBLM(""PRINT^APCHPWHR"")"
  1.  S XBRC="EN^APCHPWHR",XBRX="EXIT^APCHPWHR",XBIOP=0 D ^XBDBQUE
  1.  Q
  1. EXIT ;
  1.  ;K ^XTMP("APCHPWHR",APCHJ,APCHH)
  1.  D EN^XBVK("APCH")
  1.  K DFN
  1.  D ^XBFMK
  1.  Q
  1.  ;
  1. EXIT1 ;
  1.  D CLEAR^VALM1
  1.  D FULL^VALM1
  1.  D EN^XBVK("APCH")
  1.  K DFN
  1.  D ^XBFMK
  1.  Q
  1.  ;
  1. PRINT ;
  1.  S APCHPG=0
  1.  K APCHQUIT
  1.  I APCHLIST I '$D(^XTMP("APCHPWHR",APCHJ,APCHH)) D HEADER W !!,"No data to report.",! Q
  1.  I APCHPWHC=0 D HDR W !!,"No data to report.",! Q
  1.  ;print tally then print list
  1.  D HDR
  1.  S APCHX=0 F  S APCHX=$O(APCHPWHT(APCHX)) Q:APCHX'=+APCHX  D
  1.  .I $Y>(IOSL-3) D HDR Q:$D(APCHQUIT)
  1.  .W APCHPWHT(APCHX,0),!
  1.  .Q
  1.  Q:$D(APCHQUIT)
  1.  ;first reorder by sort item
  1.  S APCHIEN=0 F  S APCHIEN=$O(^XTMP("APCHPWHR",APCHJ,APCHH,APCHIEN)) Q:APCHIEN'=+APCHIEN  D
  1.  .D
  1.  ..S V=""
  1.  ..I APCHSORT="T" S V=$$VAL^XBDIQ1(9001027,APCHIEN,.02) Q
  1.  ..I APCHSORT="D" S V=$$VALI^XBDIQ1(9001027,APCHIEN,.04) Q
  1.  ..I APCHSORT="N" S V=$$VAL^XBDIQ1(9001027,APCHIEN,.01) Q
  1.  ..I APCHSORT="L" S V=$$VAL^XBDIQ1(9001027,APCHIEN,.06) Q
  1.  ..I APCHSORT="P" S V=$$VAL^XBDIQ1(9001027,APCHIEN,.03) Q
  1.  .I V="" S V="UNKNOWN"
  1.  .S ^XTMP("APCHPWHR",APCHJ,APCHH,"SORT",V,APCHIEN)=""
  1.  I 'APCHLIST G N
  1.  D HEADER
  1.  S APCHSV="" F  S APCHSV=$O(^XTMP("APCHPWHR",APCHJ,APCHH,"SORT",APCHSV)) Q:APCHSV=""!($D(APCHQUIT))  D
  1.  .S APCHIEN=0 F  S APCHIEN=$O(^XTMP("APCHPWHR",APCHJ,APCHH,"SORT",APCHSV,APCHIEN)) Q:APCHIEN=""!($D(APCHQUIT))  D
  1.  ..I $Y>(IOSL-3) D HEADER I $D(APCHQUIT) Q
  1.  ..W !,$$HRN^AUPNPAT($$VALI^XBDIQ1(9001027,APCHIEN,.01),DUZ(2)),?8,$E($$VAL^XBDIQ1(9001027,APCHIEN,.01),1,20)
  1.  ..W ?30,$$DATE^APCHSMU($$VALI^XBDIQ1(9001027,APCHIEN,.04)),?39,$E($$VAL^XBDIQ1(9001027,APCHIEN,.02),1,20)
  1.  ..W ?60,$E($$VAL^XBDIQ1(9001027,APCHIEN,.03),1,14),?75,$$VAL^XBDIQ1(9999999.06,+$$VALI^XBDIQ1(9001027,APCHIEN,.06),.08)
  1.  ..Q
  1.  .Q
  1. N ;
  1.  W !!
  1.  Q
  1.  G:APCHPG=0 HEAD1
  1.  I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCHQUIT="" Q
  1. HEAD1 ;
  1.  W:$D(IOF) @IOF
  1.  S APCHPG=APCHPG+1
  1.  W !,"********** CONFIDENTIAL PATIENT INFORMATION ["_$P(^VA(200,DUZ,0),U,2)_"]  "_$$FMTE^XLFDT(DT)_" **********",!
  1.  W !,"Patient Wellness Handout",?45,"Report Date: ",$$FMTE^XLFDT(DT),?72,"Page: ",APCHPG,!,$TR($J("",(IOM-2))," ","-"),!
  1.  W !,"HRN",?8,"Patient Name",?30,"Date",?39,"Type",?60,"Provider",?75,"Loc"
  1.  W !,$$REPEAT^XLFSTR("-",79),!
  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. 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.  ;
  1. EN ;
  1.  S APCHCNT=0,APCHPWHC=0
  1.  K APCHT,APCHPWHT
  1.  K ^XTMP("APCHPWHR",APCHJ,APCHH)
  1.  S ^XTMP("APCHPWHR",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^APCH PWH REPORT"
  1.  NEW X,Y,APCHN,L,P,T
  1.  ;
  1.  F  S APCHSD=$O(^APCHPWHL("AC",APCHSD)) Q:APCHSD'=+APCHSD!(APCHSD>APCHED)  D
  1.  .S APCHIEN=0 F  S APCHIEN=$O(^APCHPWHL("AC",APCHSD,APCHIEN)) Q:APCHIEN'=+APCHIEN  D
  1.  ..S APCHN=^APCHPWHL(APCHIEN,0)
  1.  ..S P=$P(^APCHPWHL(APCHIEN,0),U,1)
  1.  ..Q:$$DEMO^APCLUTL(P,APCHDEMO)
  1.  ..Q:'$P(APCHN,U,2)
  1.  ..I $D(APCHTYPE) Q:'$D(APCHTYPE($P(APCHN,U,2)))
  1.  ..I $D(APCHLOCT) Q:'$P(APCHN,U,6)  Q:'$D(APCHLOCT($P(APCHN,U,6)))
  1.  ..I $D(APCHPRVT) Q:'$P(APCHN,U,3)  Q:'$D(APCHPRVT($P(APCHN,U,3)))
  1.  ..S APCHT($$VAL^XBDIQ1(9001027,APCHIEN,.06))=$G(APCHT($$VAL^XBDIQ1(9001027,APCHIEN,.06)))+1
  1.  ..S APCHT($$VAL^XBDIQ1(9001027,APCHIEN,.06),$$VAL^XBDIQ1(9001027,APCHIEN,.02))=$G(APCHT($$VAL^XBDIQ1(9001027,APCHIEN,.06),$$VAL^XBDIQ1(9001027,APCHIEN,.02)))+1
  1.  ..S APCHT($$VAL^XBDIQ1(9001027,APCHIEN,.06),$$VAL^XBDIQ1(9001027,APCHIEN,.02),$$VAL^XBDIQ1(9001027,APCHIEN,.03))=$G(APCHT($$VAL^XBDIQ1(9001027,APCHIEN,.06),$$VAL^XBDIQ1(9001027,APCHIEN,.02),$$VAL^XBDIQ1(9001027,APCHIEN,.03)))+1
  1.  ..S ^XTMP("APCHPWHR",APCHJ,APCHH,APCHIEN)="",APCHPWHC=APCHPWHC+1
  1.  ;S X="LOCATION",$E(X,55)="#" D S(X)
  1.  S L="" F  S L=$O(APCHT(L)) Q:L=""  D
  1.  .D S(" ")
  1.  .S Y=L,$E(Y,55)=$J(APCHT(L),6) D S(Y)
  1.  .S T="" F  S T=$O(APCHT(L,T)) Q:T=""  D
  1.  ..D S(" ") S Y="",$E(Y,3)=T,$E(Y,55)=$J(APCHT(L,T),6) D S(Y)
  1.  ..D S(" ") S P="" F  S P=$O(APCHT(L,T,P)) Q:P=""  D
  1.  ...S Y="",$E(Y,6)=P,$E(Y,55)=$J(APCHT(L,T,P),6) D S(Y)
  1.  Q
  1. S(T) ;
  1.  S APCHCNT=APCHCNT+1
  1.  S APCHPWHT(APCHCNT,0)=T
  1.  Q
  1. HDR ;
  1.  G:APCHPG=0 HDR1
  1.  I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCHQUIT="" Q
  1. HDR1 ;
  1.  W:$D(IOF) @IOF
  1.  S APCHPG=APCHPG+1
  1.  W !,"********** CONFIDENTIAL PATIENT INFORMATION ["_$P(^VA(200,DUZ,0),U,2)_"]  "_$$FMTE^XLFDT(DT)_" **********",!
  1.  W $$CTR("PATIENT WELLNESS HANDOUT TALLY",80),!
  1.  W $$CTR("Date Range:  "_$$FMTE^XLFDT(APCHBD)_" - "_$$FMTE^XLFDT(APCHED)),!
  1.  S X=0,Y="" F  S X=$O(APCHTYPE(X)) Q:X'=+X  S:Y]"" Y=Y_"; " S Y=Y_$P(^APCHPWHT(X,0),U)
  1.  W "Handout Types Selected: "_$S('$D(APCHTYPE):"All",1:""),Y,!
  1.  S Y="" S X=0 F  S X=$O(APCHLOCT(X)) Q:X'=+X  S:Y]"" Y=Y_"; " S Y=Y_$E($P(^DIC(4,X,0),U),1,18)
  1.  W "Locations Selected: "_$S('$D(APCHLOCT):"All",1:""),Y,!
  1.  S Y="",X=0 F  S X=$O(APCHPRVT(X)) Q:X'=+X  S:Y]"" Y=Y_"; " S Y=Y_$E($P(^VA(200,X,0),U),1,18)
  1.  W "Providers/Users Selected: "_$S('$D(APCHPRVT):"All",1:""),Y,!
  1.  W "--------------------------------------------------------------------",!
  1.  W "LOCATION",?55,"#",!
  1.  W "--------------------------------------------------------------------",!
  1.  Q
  1.  ;
  1. HELP ;EP -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. LMEXIT ; -- exit code
  1.  K APCHPWHT,APCHT
  1.  D CLEAR^VALM1
  1.  D FULL^VALM1
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q