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

APCLHH1.m

Go to the documentation of this file. 
  1. APCLHH1 ; IHS/CMI/LAB - INFANT FEEDING REPORT #1 ;
  1.  ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
  1.  ;
  1.  ;
  1.  ;
  1. EP ;EP - called from option interactive
  1.  D EOJ
  1.  W:$D(IOF) @IOF
  1.  S APCLTEXT="INTROT" F APCLJ=1:1 S APCLX=$T(@APCLTEXT+APCLJ) Q:$P(APCLX,";;",2)="END"  S APCLT=$P(APCLX,";;",2) W !,APCLT
  1. TRIBE ;
  1.  K APCLTRIM S APCLTRIT=""
  1.  S DIR(0)="S^O:One particular Tribe;A:All Tribes;S:Selected Set of Tribes (Taxonomy)",DIR("A")="List patients who are members of",DIR("B")="O" K DA D ^DIR K DIR
  1.  I $D(DIRUT) G EOJ
  1.  S APCLTRIT=Y
  1.  I APCLTRIT="A" W !!,"Patients from all tribes will be included in the report.",! G CMMNTS
  1.  I APCLTRIT="O" D  G:'$D(APCLTRIM) TRIBE  G CMMNTS
  1.  .S DIC="^AUTTTRI(",DIC(0)="AEMQ",DIC("A")="Which TRIBE: " D ^DIC K DIC
  1.  .Q:Y=-1
  1.  .S APCLTRIM(+Y)=""
  1.  S X="TRIBE",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" S APCLERR=1 Q
  1.  D PEP^AMQQGTX0(+Y,"APCLTRIM(")
  1.  I '$D(APCLTRIM) G TRIBE
  1.  I $D(APCLTRIM("*")) K APCLTRIM G TRIBE
  1. CMMNTS ;
  1.  K APCLCOMM S APCLCOMT=""
  1.  S DIR(0)="S^O:One particular Community;A:All Communities;S:Selected Set of Communities (Taxonomy)",DIR("A")="List patients who live in",DIR("B")="O" K DA D ^DIR K DIR
  1.  I $D(DIRUT) G TRIBE
  1.  S APCLCOMT=Y
  1.  I APCLCOMT="A" W !!,"Patients from all communities will be included in the report.",! G BEN
  1.  I APCLCOMT="O" D  G:'$D(APCLCOMM) CMMNTS  G BEN
  1.  .S DIC="^AUTTCOM(",DIC(0)="AEMQ",DIC("A")="Which COMMUNITY: " D ^DIC K DIC
  1.  .Q:Y=-1
  1.  .S APCLCOMM($P(^AUTTCOM(+Y,0),U))=""
  1.  S X="COMMUNITY",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" S APCLERR=1 Q
  1.  D PEP^AMQQGTX0(+Y,"APCLCOMM(")
  1.  I '$D(APCLCOMM) G CMMNTS
  1.  I $D(APCLCOMM("*")) K APCLCOMM G CMMNTS
  1. BEN ;
  1.  S APCLBEN=""
  1.  S DIR(0)="S^1:Indian/Alaskan Native (Classification 01);2:Not Indian Alaskan/Native (Not Classification 01);3:All (both Indian/Alaskan Natives and Non 01)",DIR("A")="Select Beneficiary Population to include in this report"
  1.  S DIR("B")="1" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G CMMNTS
  1.  S APCLBEN=Y
  1. SORTR ;
  1.  S APCLSORT=""
  1.  S DIR(0)="S^H:HRN;P:Patient Name;R:Terminal Digit HRN;C:Community;T:Tribe;I:Household Income;N:Number in Household",DIR("A")="Sort Report by",DIR("B")="P" KILL DA D ^DIR KILL DIR
  1.  I $D(DIRUT) G CMMNTS
  1.  S APCLSORT=Y
  1. ZIS ;
  1. DEMO ;
  1.  D DEMOCHK^APCLUTL(.APCLDEMO)
  1.  I APCLDEMO=-1 G SORTR
  1.  S XBRP="PRINT^APCLHH1",XBRC="PROC^APCLHH1",XBRX="EOJ^APCLHH1",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.  S APCLJ=$J,APCLH=$H,APCLTOTP=0,APCLTHI=0,APCLTNHH=0,APCLTWD("NHH")=0,APCLTWD("THI")=0
  1.  S ^XTMP("APCLHH1",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"HOUSEHOLD INCOME REPORT"
  1.  S DFN=0 F  S DFN=$O(^AUPNPAT(DFN)) Q:DFN'=+DFN  D
  1.  .Q:'$D(^DPT(DFN))
  1.  .Q:'$D(^AUPNPAT(DFN))
  1.  .Q:'$D(^AUPNPAT(DFN,0))
  1.  .Q:$$DEMO^APCLUTL(DFN,$G(APCLDEMO))
  1.  .S APCLHI=$P(^AUPNPAT(DFN,0),U,36)
  1.  .S APCLNHH=$P(^AUPNPAT(DFN,0),U,35)
  1.  .I APCLBEN=1,$$BEN^AUPNPAT(DFN,"C")'="01" Q  ;want only indians
  1.  .I APCLBEN=2,$$BEN^AUPNPAT(DFN,"C")="01" Q  ;want only non indians
  1.  .;check tribe
  1.  .I $D(APCLTRIM) S X=$P($G(^AUPNPAT(DFN,11)),U,8) I X,'$D(APCLTRIM(X)) Q  ;not correct tribe
  1.  .I $D(APCLCOMM) S X=$P($G(^AUPNPAT(DFN,11)),U,18) I X,'$D(APCLCOMM(X)) Q  ;not correct community
  1.  .S APCLTOTP=APCLTOTP+1
  1.  .I APCLNHH="",APCLHI="" Q  ;no data
  1.  .I APCLNHH]"" S APCLTWD("NHH")=$G(APCLTWD("NHH"))+1
  1.  .I APCLHI]"" S APCLTWD("THI")=$G(APCLTWD("THI"))+1
  1.  .S X=$$SORT(DFN,APCLSORT)
  1.  .I X="" S X="---"
  1.  .S ^XTMP("APCLHH1",APCLJ,APCLH,"PTS",X,DFN)=APCLNHH_U_APCLHI
  1.  .S APCLTHI=APCLTHI+APCLHI
  1.  .S APCLTNHH=APCLTNHH+APCLNHH
  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("APCLHH1",APCLJ,APCLH),APCLJ,APCLH
  1.  Q
  1.  ;
  1.  ;
  1. PRINT ;EP - called from xbdbque
  1.  S APCLQ=0,APCLPG=0
  1.  D HEADER
  1.  S APCLSV="" F  S APCLSV=$O(^XTMP("APCLHH1",APCLJ,APCLH,"PTS",APCLSV)) Q:APCLSV=""!(APCLQ)  D
  1.  .S DFN=0 F  S DFN=$O(^XTMP("APCLHH1",APCLJ,APCLH,"PTS",APCLSV,DFN)) Q:DFN'=+DFN  D
  1.  ..S Y=DFN D ^AUPNPAT
  1.  ..I $Y>(IOSL-3) D HEADER Q:APCLQ
  1.  ..W !,$E($P(^DPT(DFN,0),U),1,20),?22,$$HRN^AUPNPAT(DFN,DUZ(2)),?30,$$BEN^AUPNPAT(DFN,"C"),?34,$E($$VAL^XBDIQ1(9000001,DFN,1118),1,9)
  1.  ..W ?44,$E($$VAL^XBDIQ1(2,DFN,.116),1,5),?50,$E($$VAL^XBDIQ1(9000001,DFN,1108),1,10)
  1.  ..S APCLX=^XTMP("APCLHH1",APCLJ,APCLH,"PTS",APCLSV,DFN)
  1.  ..S APCLHI=$P(APCLX,U,2)
  1.  ..S APCLNHH=$P(APCLX,U,1)
  1.  ..W ?62,$J(APCLNHH,3)
  1.  ..W ?69,$$C(APCLHI,0,10)
  1.  ..Q
  1.  .Q
  1.  ;NOW PRINT AVERAGES
  1.  I APCLTWD("NHH") S X=(APCLTNHH/APCLTWD("NHH")) D
  1.  .I $Y>(IOSL-2) D HEADER Q:APCLQ
  1.  .W !!?3,"Total Number of Patients with Number in Household documented: ",$J(APCLTWD("NHH"),6,0)
  1.  .W !?3,"Average Number in Household:  ",$J(X,5,1)
  1.  I APCLTWD("THI") S X=(APCLTHI/APCLTWD("THI")) D
  1.  .I $Y>(IOSL-2) D HEADER Q:APCLQ
  1.  .W !!?3,"Total Number of Patients with Total Household Income documented: ",$J(APCLTWD("THI"),6,0)
  1.  .W !?3,"Average Total Household Income:  ",$$C(X,0,12)
  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=1 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($P(^DIC(4,DUZ(2),0),U),80),!
  1.  W !,$$CTR("HOUSEHOLD INCOME/NUMBER IN HOUSEHOLD TALLY",80)
  1.  S X="Communities: "
  1.  I APCLCOMT="O" S X=X_$O(APCLCOMM(""))
  1.  I APCLCOMT="A" S X=X_"All Communities"
  1.  I APCLCOMT="S" D
  1.  .S Y="" F  S Y=$O(APCLCOMM(Y)) Q:Y'=+Y  S X=X_" "_Y
  1.  I APCLTRIT="O" S X=X_$O(APCLTRIM(""))
  1.  I APCLTRIT="A" S X=X_"All Communities"
  1.  I APCLTRIT="S" D
  1.  .S Y="" F  S Y=$O(APCLTRIM(Y)) Q:Y'=+Y  S X=X_" "_$P(^AUTTTRI(Y,0),U)
  1.  W !!,"Patient Name",?22,"HRN",?29,"BENI",?34,"COMMUNITY",?44,"ZIP",?50,"TRIBE",?61,"# IN",?69,"TOTAL"
  1.  W !?29,"FICI",?61,"HOUSE",?69,"HOUSEHOLD",!?29,"ARY",?61,"HOLD",?69,"INCOME"
  1.  W !,$TR($J("",80)," ","-")
  1.  Q
  1. D(D) ;
  1.  Q $E(D,4,5)_"/"_$E(D,6,7)_"/"_(1700+$E(D,1,3))
  1. C(X,X2,X3) ;
  1.  D COMMA^%DTC
  1.  Q X
  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.  ;----------
  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. SORT(P,S) ;
  1.  NEW R
  1.  S R=""
  1.  D @(S_"SORT")
  1.  I R="" S R="ZZZZZZZZ"
  1.  Q R
  1.  ;
  1. ISORT ;
  1.  S X=$$VAL^XBDIQ1(9000001,P,.36)
  1.  Q
  1. NSORT ;
  1.  S X=$$VAL^XBDIQ1(9000001,P,.35)
  1.  Q
  1. CSORT ;
  1.  S X=$$VAL^XBDIQ1(9000001,P,1118)
  1.  Q
  1. TSORT ;
  1.  S R=$$VAL^XBDIQ1(9000001,P,1108)
  1.  Q
  1. PSORT ;
  1.  S R=$$VAL^XBDIQ1(2,P,.01)
  1.  Q
  1.  ;
  1. HSORT ;
  1.  S R=$$HRN^AUPNPAT(P,DUZ(2))
  1.  Q
  1.  ;
  1. RSORT ;
  1.  S R=$$HRN^AUPNPAT(P,DUZ(2))
  1.  S R=R+10000000,R=$E(R,7,8)_$E(R,1,6)
  1.  Q
  1. INTROT ;
  1.  ;;                 NUMBER IN HOUSEHOLD/TOTAL INCOME REPORT
  1.  ;;
  1.  ;;This option will produce a report of all patients who have the number
  1.  ;;in household or total household income recorded.  You will be able
  1.  ;;to select to list all patients from a particular community or tribe.
  1.  ;;
  1.  ;;The report can be sorted by either HRN, Terminal Digit HRN, 
  1.  ;;Community, Tribe, Household Income, Number in Household or Patient Name.
  1.  ;;
  1.  ;;An average of the household income and number in household will also
  1.  ;;be displayed.
  1.  ;;
  1.  ;;END