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

APCLDOD1.m

Go to the documentation of this file. 
  1. APCLDOD1 ; IHS/CMI/LAB - INFANT FEEDING REPORT #1 ;
  1.  ;;2.0;IHS PCC SUITE;**8**;MAY 14, 2009;Build 2
  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. GETDATES ;
  1. BD ;get beginning date
  1.  W ! S DIR(0)="D^:DT:EP",DIR("A")="Enter beginning Date of Death" D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) G EOJ
  1.  S APCLBD=Y
  1. ED ;get ending date
  1.  K DIR W ! S DIR(0)="DA^"_APCLBD_":DT:EP",DIR("A")="Enter ending Date of Death: " D ^DIR K DIR S:$D(DUOUT) DIRUT=1
  1.  I $D(DIRUT) G BD
  1.  S APCLED=Y
  1.  S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X
  1.  ;
  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 GETDATES
  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 SORTR
  1.  I APCLCOMT="O" D  G:'$D(APCLCOMM) CMMNTS  G SORTR
  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. SORTR ;
  1.  S APCLSORT=""
  1.  S DIR(0)="S^D:Date of Death;H:HRN;R:Terminal Digit HRN;C:Community;T:Tribe;N:Patient Name",DIR("A")="Sort Report by",DIR("B")="D" 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^APCLDOD1",XBRC="PROC^APCLDOD1",XBRX="EOJ^APCLDOD1",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,APCLSD=APCLSD_".9999"
  1.  S ^XTMP("APCLDOD1",0)=$$FMADD^XLFDT(DT,14)_"^"_DT_"^"_"DATE OF DEATH REPORT"
  1.  S DFN=0 F  S APCLSD=$O(^DPT("AEXP1",APCLSD)) Q:APCLSD'=+APCLSD!($P(APCLSD,".")>APCLED)  D
  1.  .S DFN=0 F  S DFN=$O(^DPT("AEXP1",APCLSD,DFN)) Q:DFN'=+DFN  D
  1.  ..Q:'$D(^DPT(DFN))
  1.  ..Q:'$D(^AUPNPAT(DFN))
  1.  ..Q:$$DEMO^APCLUTL(DFN,$G(APCLDEMO))
  1.  ..;check tribe
  1.  ..I $D(APCLTRIM) S X=$P($G(^AUPNPAT(DFN,11)),U,8) I '$D(APCLTRIM(X)) Q  ;not correct tribe
  1.  ..I $D(APCLCOMM) S X=$P($G(^AUPNPAT(DFN,11)),U,18) I '$D(APCLCOMM(X)) Q  ;not correct community
  1.  ..S X=$$SORT(DFN,APCLSORT)
  1.  ..I X="" S X="---"
  1.  ..S ^XTMP("APCLDOD1",APCLJ,APCLH,"PTS",X,DFN)=""
  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("APCLDOD1",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("APCLDOD1",APCLJ,APCLH,"PTS",APCLSV)) Q:APCLSV=""!(APCLQ)  D
  1.  .S DFN=0 F  S DFN=$O(^XTMP("APCLDOD1",APCLJ,APCLH,"PTS",APCLSV,DFN)) Q:DFN'=+DFN!(APCLQ)  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,23),?25,$$HRN^AUPNPAT(DFN,DUZ(2)),?32,$$D($P(^DPT(DFN,0),U,3)),?45,$$AGE^AUPNPAT(DFN,AUPNDOD)
  1.  ..W ?50,$$D(AUPNDOD),?61,$E($$VAL^XBDIQ1(9000001,DFN,1108),1,18)
  1.  ..W !?2,"Underlying Cause of Death: ",$$VAL^XBDIQ1(9000001,DFN,1114)
  1.  ..W !?2,"Last Visit: ",$$LASTVD(DFN,AUPNDOB,AUPNDOD)
  1.  ..W !?2,"Last Inpatient Visit: ",$$LASTVD(DFN,AUPNDOB,AUPNDOD,1)
  1.  ..W !?2,"Community of Residence: ",$$VAL^XBDIQ1(9000001,DFN,1118)
  1.  ..Q
  1.  .Q
  1.  Q
  1. LASTVD(P,BDATE,EDATE,H) ;
  1.  K ^TMP($J,"A")
  1.  S H=$G(H)
  1.  S A="^TMP($J,""A"",",B=P_"^ALL VISITS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE),E=$$START1^APCLDF(B,A)
  1.  I '$D(^TMP($J,"A",1)) Q ""
  1.  S (X,G)="" F  S X=$O(^TMP($J,"A",X)) Q:X'=+X!(G)  S V=$P(^TMP($J,"A",X),U,5) D
  1.  .Q:'$D(^AUPNVSIT(V,0))
  1.  .Q:'$P(^AUPNVSIT(V,0),U,9)
  1.  .Q:$P(^AUPNVSIT(V,0),U,11)
  1.  .Q:'$D(^AUPNVPRV("AD",V))
  1.  .Q:"SAHORI"'[$P(^AUPNVSIT(V,0),U,7)
  1.  .I H,$P(^AUPNVSIT(V,0),U,7)'="H" Q
  1.  .S G=V
  1.  .Q
  1.  I 'G Q ""
  1.  Q $$D($P($P(^AUPNVSIT(G,0),U),"."))_" "_$$VAL^XBDIQ1(9000010,V,.06)_"  - "_$$VAL^XBDIQ1(9000010,V,.07)
  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("DECEASED PATIENTS REPORT",80),!
  1.  S X="Date of Death: "_$$FMTE^XLFDT(APCLBD)_" - "_$$FMTE^XLFDT(APCLED) W $$CTR(X,80),!
  1.  W !,"Patient Name",?25,"HRN",?32,"DOB",?43,"Age at",?50,"DOD",?61,"Tribe"
  1.  W !?43,"Death"
  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. DSORT ;
  1.  S R=$$VALI^XBDIQ1(2,P,.351)
  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. NSORT ;
  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.  ;;                 DECEASED PATIENT LISTING
  1.  ;;
  1.  ;;This option will produce a report of all patients who have a Date of
  1.  ;;Death entered into RPMS. You will be required to enter a date of
  1.  ;;death date range.  If you want all patients with a DOD entered then
  1.  ;;enter a very early beginning date (e.g. 01/01/1890).
  1.  ;;
  1.  ;;The report can be sorted by either HRN, Terminal Digit HRN, Date of
  1.  ;;Death, Community, Tribe, or Patient Name.
  1.  ;;
  1.  ;;END