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