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

APCLCH11.m

Go to the documentation of this file. 
  1. APCLCH11 ; IHS/CMI/LAB - community health profile ;
  1.  ;;2.0;IHS PCC SUITE;**7**;MAY 14, 2009
  1.  ;IHS/CMI/LAB - Y2K patch 4
  1.  ;
  1.  ;
  1. START ;
  1.  S APCLBT=$H
  1.  S APCLAGER="0-4;5-9;10-19;20-29;30-39;40-49;50-59;60-69;70-79;80 +;TOTAL"
  1.  S APCLAGEP=" 0-4 ; 5-9 ;10-19;20-29;30-39;40-49;50-59;60-69;70-79;80 +;TOTAL"
  1.  ;table service unit communities
  1.  S X=0 F  S X=$O(^AUTTCOM(X)) Q:X'=+X  I $P(^AUTTCOM(X,0),U,5)=APCLSU S ^XTMP("APCLCH1",APCLJOB,APCLBTH,"SU COMM",X)=""
  1. POP ;community health profile
  1. PAT S APCLDFN=0 F  S APCLDFN=$O(^AUPNPAT(APCLDFN)) Q:APCLDFN'=+APCLDFN  I $D(^DPT(APCLDFN)),$D(^AUPNPAT(APCLDFN,0)),'$P(^DPT(APCLDFN,0),U,19) D KILL^AUPNPAT S Y=APCLDFN D ^AUPNPAT D PROC
  1.  D SET^APCLCH1
  1.  S APCLET=$H
  1.  Q
  1. PROC ;
  1.  Q:'$D(^AUPNPAT(APCLDFN,41,DUZ(2)))  ;no chart at this facility
  1.  I $G(APCLSEAT) Q:'$D(^DIBT(APCLSEAT,1,APCLDFN))
  1.  Q:$$DEMO^APCLUTL(APCLDFN,$G(APCLDEMO))
  1.  I $G(AUPNDOD)]"",AUPNDOD'>APCLBD Q  ;died before time frame
  1.  Q:APCLED<$$DOB^AUPNPAT(APCLDFN)
  1.  S (APCLLCOM,APCLSCOM)=0
  1.  S APCLCOM=$$COMMRES^AUPNPAT(APCLDFN,"E"),APCLCOMI=$$COMMRES^AUPNPAT(APCLDFN,"I")
  1.  Q:APCLCOM=""
  1.  Q:APCLCOM=-1
  1.  I $D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"COMMUNITIES",APCLCOM)) S APCLLCOM=1
  1.  I $D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"SU COMM",APCLCOMI)) S APCLSCOM=1
  1.  I APCLLCOM D  I 1
  1.  .D SETV^APCLCH1S
  1.  .D LIVREG
  1.  .D DEATHS
  1.  .D BIRTHS
  1.  .D THIRD
  1.  .D AGEDIST
  1. V ;
  1.  I 'APCLLCOM,'APCLSCOM Q  ;not in either communities selected or su
  1.  D INOUTDX
  1.  D SURGPROC
  1.  D DENTAL
  1.  K ^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"TEMP")
  1.  Q
  1. LIVREG ;
  1.  S ^("LIVREG")=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"LIVREG")):(+^("LIVREG")+1),1:1)
  1.  Q
  1.  ;
  1.  ;
  1. HADHC ;did the pt have a visit during time frame - count all except Events
  1.  K APCLCH1Y,APCLX,APCLY,APCLER
  1.  ;begin y2k
  1.  ;S APCLX=APCLDFN_"^LAST 50 VISITS ;DURING "_$$FMTE^XLFDT(APCLBD,"2D")_"-"_$$FMTE^XLFDT(APCLED,"2D") S APCLER=$$START1^APCLDF(APCLX,"APCLCH1Y(") ;Y2000
  1.  S APCLX=APCLDFN_"^LAST 50 VISITS ;DURING "_$$FMTE^XLFDT(APCLBD,"5D")_"-"_$$FMTE^XLFDT(APCLED,"5D") S APCLER=$$START1^APCLDF(APCLX,"APCLCH1Y(") ;Y2000
  1.  ;end Y2K
  1.  Q:'$D(APCLCH1Y)
  1.  ;GO THROUGH VISITS AND FIND ONE THAT IS NOT AN E, NOT DELETED OR NO DEP ENTRIES
  1.  S (X,H)=0 F  S X=$O(APCLCH1Y(X)) Q:X'=+X!(H)  I $P(APCLCH1Y(X),U,5),$P(^AUPNVSIT($P(APCLCH1Y(X),U,5),0),U,7)'="E",$P(^(0),U,9),'$P(^(0),U,11),$D(^AUPNVPOV("AD",$P(APCLCH1Y(X),U,5))) S H=1
  1.  I H S ^("HADHC")=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"HADHC")):(+^("HADHC")+1),1:1)
  1.  K H,APCLCH1Y,APCLER,APCLX,APCLY,X
  1.  Q
  1. BIRTHS ;
  1.  S DOB=$P(^DPT(APCLDFN,0),U,3)
  1.  Q:DOB=""
  1.  I DOB'<APCLBD,DOB'>APCLED S ^("BIRTHS")=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"BIRTHS")):(+^("BIRTHS")+1),1:1)
  1.  Q
  1. DEATHS ;
  1.  Q:$G(AUPNDOD)=""
  1.  I AUPNDOD'<APCLBD,AUPNDOD'>APCLED S ^("DEATHS")=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"DEATHS")):(+^("DEATHS")+1),1:1)
  1.  Q
  1. AGEDIST ;
  1.  S A=$$AGE^AUPNPAT(DFN,APCLED)
  1.  I A=-1!(A="")!(AUPNSEX="") Q  ;can't use if no sex or DOB/age
  1.  F I=1:1:10 I A'<+$P(APCLAGER,";",I) S T=I
  1.  S $P(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"AGE DIST",AUPNSEX),U,T)=$P(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"AGE DIST",AUPNSEX),U,T)+1
  1.  S $P(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"AGE DIST",AUPNSEX),U,11)=$P(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"AGE DIST",AUPNSEX),U,11)+1
  1.  Q
  1. INOUTDX ;tally inpt and outp dx for su/report
  1.  ;get all visits in time frame for patient
  1.  K ^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"TEMP"),APCLY,APCLX
  1.  ;begin Y2K
  1.  ;S APCLY="^XTMP(""APCLCH1"",APCLJOB,APCLBTH,""RP"",APCLCOM,""TEMP"",",APCLX=APCLDFN_"^ALL DIAGNOSIS;DURING "_$$FMTE^XLFDT(APCLBD,"2D")_"-"_$$FMTE^XLFDT(APCLED,"2D") ;Y2000
  1.  S APCLY="^XTMP(""APCLCH1"",APCLJOB,APCLBTH,""RP"",APCLCOM,""TEMP"",",APCLX=APCLDFN_"^ALL DIAGNOSIS;DURING "_$$FMTE^XLFDT(APCLBD,"5D")_"-"_$$FMTE^XLFDT(APCLED,"5D") ;Y2000
  1.  ;end Y2K
  1.  S APCLER=$$START1^APCLDF(APCLX,APCLY)
  1.  Q:'$D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"TEMP"))  ;no dxs
  1.  ;go through visits - ignore del/0dep tally
  1.  I APCLLCOM S ^("HADHC")=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"HADHC")):(+^("HADHC")+1),1:1)
  1.  S X=0 F  S X=$O(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"TEMP",X)) Q:X'=+X  D
  1.  .S R=^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"TEMP",X)
  1.  .S P=+$P(R,U,4),Q=$P(^AUPNVPOV(P,0),U)
  1.  .I $$SC^APCLV($P(R,U,5),"I")="H",APCLLCOM S ^(Q)=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"REPORT","INDX",Q)):^(Q)+1,1:1)
  1.  .I $$SC^APCLV($P(R,U,5),"I")="H",APCLSCOM S ^(Q)=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"SU","INDX",Q)):^(Q)+1,1:1)
  1.  .I "AORS"[$$SC^APCLV($P(R,U,5),"I"),APCLLCOM S ^(Q)=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"REPORT","OUTDX",Q)):^(Q)+1,1:1)
  1.  .I "AORS"[$$SC^APCLV($P(R,U,5),"I"),APCLSCOM S ^(Q)=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"SU","OUTDX",Q)):^(Q)+1,1:1)
  1. INJ ;
  1.  S X=0 F  S X=$O(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"TEMP",X)) Q:X'=+X  D
  1.  .S R=^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"TEMP",X)
  1.  .S P=+$P(R,U,4),Q=$P(^AUPNVPOV(P,0),U,9)
  1.  .Q:Q=""
  1.  .I APCLLCOM S ^(Q)=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"REPORT","INJ",Q)):^(Q)+1,1:1)
  1.  .I APCLSCOM S ^(Q)=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"SU","INJ",Q)):^(Q)+1,1:1)
  1.  Q
  1. SURGPROC  ;
  1.  K ^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"TEMP"),APCLY,APCLX
  1.  ;begin Y2K
  1.  ;S APCLY="^XTMP(""APCLCH1"",APCLJOB,APCLBTH,""RP"",APCLCOM,""TEMP"",",APCLX=APCLDFN_"^ALL PROCEDURES;DURING "_$$FMTE^XLFDT(APCLBD,"2D")_"-"_$$FMTE^XLFDT(APCLED,"2D") ;Y2000
  1.  S APCLY="^XTMP(""APCLCH1"",APCLJOB,APCLBTH,""RP"",APCLCOM,""TEMP"",",APCLX=APCLDFN_"^ALL PROCEDURES;DURING "_$$FMTE^XLFDT(APCLBD,"5D")_"-"_$$FMTE^XLFDT(APCLED,"5D") ;Y2000
  1.  ;end Y2K
  1.  S APCLER=$$START1^APCLDF(APCLX,APCLY)
  1.  Q:'$D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"TEMP"))  ;no dxs
  1.  ;go through visits - ignore del/0dep tally
  1.  S X=0 F  S X=$O(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"TEMP",X)) Q:X'=+X  D
  1.  .S R=^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"TEMP",X)
  1.  .S P=+$P(R,U,4),Q=$P(^AUPNVPRC(P,0),U)
  1.  .I APCLLCOM S ^(Q)=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"REPORT","SURG PROC",Q)):^(Q)+1,1:1)
  1.  .I APCLSCOM S ^(Q)=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"SU","SURG PROC",Q)):^(Q)+1,1:1)
  1.  .Q
  1.  Q
  1. DENTAL ;
  1.  K ^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"TEMP"),APCLY,APCLX
  1.  ;begin Y2K
  1.  ;S APCLY="^XTMP(""APCLCH1"",APCLJOB,APCLBTH,""RP"",APCLCOM,""TEMP"",",APCLX=APCLDFN_"^ALL ADA;DURING "_$$FMTE^XLFDT(APCLBD,"2D")_"-"_$$FMTE^XLFDT(APCLED,"2D") ;Y2000
  1.  S APCLY="^XTMP(""APCLCH1"",APCLJOB,APCLBTH,""RP"",APCLCOM,""TEMP"",",APCLX=APCLDFN_"^ALL ADA;DURING "_$$FMTE^XLFDT(APCLBD,"5D")_"-"_$$FMTE^XLFDT(APCLED,"5D") ;Y2000
  1.  ;end Y2K
  1.  S APCLER=$$START1^APCLDF(APCLX,APCLY)
  1.  Q:'$D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"TEMP"))  ;no dxs
  1.  S X=0 F  S X=$O(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"TEMP",X)) Q:X'=+X  D
  1.  .S R=^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"TEMP",X)
  1.  .S P=+$P(R,U,4),Q=$P(^AUPNVDEN(P,0),U)
  1.  .I APCLLCOM S ^(Q)=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"REPORT","DENT",Q)):^(Q)+1,1:1)
  1.  .I APCLSCOM S ^(Q)=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"SU","DENT",Q)):^(Q)+1,1:1)
  1.  .Q
  1.  Q
  1. THIRD ;
  1.  S APCLVAL="A" D MCRA
  1.  S APCLVAL="B" D MCRA
  1.  D PI,MCD
  1.  Q
  1. MCRA ;
  1.  Q:'$D(^AUPNMCR(DFN,11))
  1.  K APCLGOT S APCLMDFN=0 F  S APCLMDFN=$O(^AUPNMCR(DFN,11,APCLMDFN)) Q:APCLMDFN'=+APCLMDFN!($D(APCLGOT))  D MCRA2
  1.  Q:'$D(APCLGOT)
  1.  I APCLVAL="A" S ^("MCRA")=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"MCRA")):(+^("MCRA")+1),1:1)
  1.  I APCLVAL="B" S ^("MCRB")=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"MCRB")):(+^("MCRB")+1),1:1)
  1.  Q
  1.  ;
  1. MCRA2 ;
  1.  Q:APCLVAL'[$P(^AUPNMCR(DFN,11,APCLMDFN,0),U,3)
  1.  Q:$P(^AUPNMCR(DFN,11,APCLMDFN,0),U)>APCLBD  ;quit if policy started after the end of time frame
  1.  I $P(^AUPNMCR(DFN,11,APCLMDFN,0),U,2)]"",$P(^(0),U,2)<APCLBD Q  ;quit if policy ended before beginning of time frame
  1.  S APCLGOT=""
  1.  Q
  1.  ;
  1. PI ;
  1.  I $$PI^AUPNPAT(DFN,APCLBD) S ^("PI")=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"PI")):(+^("PI")+1),1:1)
  1.  Q
  1. MCD ;
  1.  I $$MCD^AUPNPAT(DFN,APCLBD) S ^("MCD")=$S($D(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLCOM,"MCD")):(+^("MCD")+1),1:1)
  1.  Q