APCLCH21 ; IHS/CMI/LAB - community health profile ;
;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
;
;cmi/anch/maw 9/10/2007 code set versioning in DX
;
START ;
S APCLBT=$H
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^APCLCH2
S APCLET=$H
Q
PROC ;
Q:$$DEMO^APCLUTL(APCLDFN,$G(APCLDEMO))
I $G(AUPNDOD)]"",AUPNDOD'>APCLBD Q ;died before time frame
S APCLCOM=$$COMMRES^AUPNPAT(APCLDFN,"E"),APCLCOMI=$$COMMRES^AUPNPAT(APCLDFN,"I")
Q:APCLCOMI=""
Q:APCLCOMI=-1
Q:'$D(^XTMP("APCLCH2",APCLJOB,APCLBTH,"COMMUNITIES",APCLCOMI)) ;do not use patient if not in a community of interest
K APCLLOC
S APCLLFAC=$P(^AUTTCOM(APCLCOMI,0),U,15),APCLLOC(APCLLFAC)=""
S APCLSFAC=$P(^AUTTCOM(APCLCOMI,0),U,16),APCLLOC(APCLSFAC)=""
S APCLTFAC=$P(^AUTTCOM(APCLCOMI,0),U,17),APCLLOC(APCLTFAC)=""
D V
Q
V ; Run by visit date
S APCLV=0,APCLBDO=(9999999-APCLBD)_".9999",APCLEDO=(9999999-APCLED),APCLSD=(APCLEDO-1)_".9999"
F S APCLSD=$O(^AUPNVSIT("AA",DFN,APCLSD)) Q:APCLSD>APCLBDO!(APCLSD="") D
.S APCLV=0 F S APCLV=$O(^AUPNVSIT("AA",DFN,APCLSD,APCLV)) Q:APCLV'=+APCLV D
..Q:'$P(^AUPNVSIT(APCLV,0),U,9)
..Q:$P(^AUPNVSIT(APCLV,0),U,11)
..Q:"E"[$P(^AUPNVSIT(APCLV,0),U,7)
..Q:'$D(^AUPNVPOV("AD",APCLV))
..S APCLVLOC=$P(^AUPNVSIT(APCLV,0),U,6)
..Q:'$D(APCLLOC(APCLVLOC))
..D DX
..Q
.Q
Q
DX ;
S APCLP=0 F S APCLP=$O(^AUPNVPOV("AD",APCLV,APCLP)) Q:APCLP'=+APCLP S APCLDX=$P(^AUPNVPOV(APCLP,0),U) D
.I $P(^AUPNVSIT(APCLV,0),U,7)="H" D Q
..S ^(APCLDX)=$S($D(^XTMP("APCLCH2",APCLJOB,APCLBTH,"DATA",APCLCOMI,APCLVLOC,"INDX",APCLDX)):^(APCLDX)+1,1:1)
..;S %=$P(^ICD9(APCLDX,0),U,5) I % S ^(%)=$S($D(^XTMP("APCLCH2",APCLJOB,APCLBTH,"DATA",APCLCOMI,APCLVLOC,"INCAT",%)):^(%)+1,1:1) ;cmi/anch/maw 9/10/2007 orig line
..S %=$P($$ICDDX^ICDEX(APCLDX),U,6) I % S ^(%)=$S($D(^XTMP("APCLCH2",APCLJOB,APCLBTH,"DATA",APCLCOMI,APCLVLOC,"INCAT",%)):^(%)+1,1:1) ;cmi/anch/maw 9/10/2007 csv
.I "AORSTC"[$P(^AUPNVSIT(APCLV,0),U,7) D
..S ^(APCLDX)=$S($D(^XTMP("APCLCH2",APCLJOB,APCLBTH,"DATA",APCLCOMI,APCLVLOC,"OUTDX",APCLDX)):^(APCLDX)+1,1:1)
..;S %=$P(^ICD9(APCLDX,0),U,5) I % S ^(%)=$S($D(^XTMP("APCLCH2",APCLJOB,APCLBTH,"DATA",APCLCOMI,APCLVLOC,"OUTCAT",%)):^(%)+1,1:1) ;cmi/anch/maw 9/10/2007 orig line
..S %=$P($$ICDDX^ICDEX(APCLDX),U,6) I % S ^(%)=$S($D(^XTMP("APCLCH2",APCLJOB,APCLBTH,"DATA",APCLCOMI,APCLVLOC,"OUTCAT",%)):^(%)+1,1:1) ;cmi/anch/maw 9/10/2007 csv
.Q
Q
APCLCH21 ; IHS/CMI/LAB - community health profile ;
+1 ;;2.0;IHS PCC SUITE;**11**;MAY 14, 2009;Build 58
+2 ;
+3 ;cmi/anch/maw 9/10/2007 code set versioning in DX
+4 ;
START ;
+1 SET APCLBT=$HOROLOG
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^APCLCH2
+2 SET APCLET=$HOROLOG
+3 QUIT
PROC ;
+1 IF $$DEMO^APCLUTL(APCLDFN,$GET(APCLDEMO))
QUIT
+2 ;died before time frame
IF $GET(AUPNDOD)]""
IF AUPNDOD'>APCLBD
QUIT
+3 SET APCLCOM=$$COMMRES^AUPNPAT(APCLDFN,"E")
SET APCLCOMI=$$COMMRES^AUPNPAT(APCLDFN,"I")
+4 IF APCLCOMI=""
QUIT
+5 IF APCLCOMI=-1
QUIT
+6 ;do not use patient if not in a community of interest
IF '$DATA(^XTMP("APCLCH2",APCLJOB,APCLBTH,"COMMUNITIES",APCLCOMI))
QUIT
+7 KILL APCLLOC
+8 SET APCLLFAC=$PIECE(^AUTTCOM(APCLCOMI,0),U,15)
SET APCLLOC(APCLLFAC)=""
+9 SET APCLSFAC=$PIECE(^AUTTCOM(APCLCOMI,0),U,16)
SET APCLLOC(APCLSFAC)=""
+10 SET APCLTFAC=$PIECE(^AUTTCOM(APCLCOMI,0),U,17)
SET APCLLOC(APCLTFAC)=""
+11 DO V
+12 QUIT
V ; Run by visit date
+1 SET APCLV=0
SET APCLBDO=(9999999-APCLBD)_".9999"
SET APCLEDO=(9999999-APCLED)
SET APCLSD=(APCLEDO-1)_".9999"
+2 FOR
SET APCLSD=$ORDER(^AUPNVSIT("AA",DFN,APCLSD))
IF APCLSD>APCLBDO!(APCLSD="")
QUIT
Begin DoDot:1
+3 SET APCLV=0
FOR
SET APCLV=$ORDER(^AUPNVSIT("AA",DFN,APCLSD,APCLV))
IF APCLV'=+APCLV
QUIT
Begin DoDot:2
+4 IF '$PIECE(^AUPNVSIT(APCLV,0),U,9)
QUIT
+5 IF $PIECE(^AUPNVSIT(APCLV,0),U,11)
QUIT
+6 IF "E"[$PIECE(^AUPNVSIT(APCLV,0),U,7)
QUIT
+7 IF '$DATA(^AUPNVPOV("AD",APCLV))
QUIT
+8 SET APCLVLOC=$PIECE(^AUPNVSIT(APCLV,0),U,6)
+9 IF '$DATA(APCLLOC(APCLVLOC))
QUIT
+10 DO DX
+11 QUIT
End DoDot:2
+12 QUIT
End DoDot:1
+13 QUIT
DX ;
+1 SET APCLP=0
FOR
SET APCLP=$ORDER(^AUPNVPOV("AD",APCLV,APCLP))
IF APCLP'=+APCLP
QUIT
SET APCLDX=$PIECE(^AUPNVPOV(APCLP,0),U)
Begin DoDot:1
+2 IF $PIECE(^AUPNVSIT(APCLV,0),U,7)="H"
Begin DoDot:2
+3 SET ^(APCLDX)=$SELECT($DATA(^XTMP("APCLCH2",APCLJOB,APCLBTH,"DATA",APCLCOMI,APCLVLOC,"INDX",APCLDX)):^(APCLDX)+1,1:1)
+4 ;S %=$P(^ICD9(APCLDX,0),U,5) I % S ^(%)=$S($D(^XTMP("APCLCH2",APCLJOB,APCLBTH,"DATA",APCLCOMI,APCLVLOC,"INCAT",%)):^(%)+1,1:1) ;cmi/anch/maw 9/10/2007 orig line
+5 ;cmi/anch/maw 9/10/2007 csv
SET %=$PIECE($$ICDDX^ICDEX(APCLDX),U,6)
IF %
SET ^(%)=$SELECT($DATA(^XTMP("APCLCH2",APCLJOB,APCLBTH,"DATA",APCLCOMI,APCLVLOC,"INCAT",%)):^(%)+1,1:1)
End DoDot:2
QUIT
+6 IF "AORSTC"[$PIECE(^AUPNVSIT(APCLV,0),U,7)
Begin DoDot:2
+7 SET ^(APCLDX)=$SELECT($DATA(^XTMP("APCLCH2",APCLJOB,APCLBTH,"DATA",APCLCOMI,APCLVLOC,"OUTDX",APCLDX)):^(APCLDX)+1,1:1)
+8 ;S %=$P(^ICD9(APCLDX,0),U,5) I % S ^(%)=$S($D(^XTMP("APCLCH2",APCLJOB,APCLBTH,"DATA",APCLCOMI,APCLVLOC,"OUTCAT",%)):^(%)+1,1:1) ;cmi/anch/maw 9/10/2007 orig line
+9 ;cmi/anch/maw 9/10/2007 csv
SET %=$PIECE($$ICDDX^ICDEX(APCLDX),U,6)
IF %
SET ^(%)=$SELECT($DATA(^XTMP("APCLCH2",APCLJOB,APCLBTH,"DATA",APCLCOMI,APCLVLOC,"OUTCAT",%)):^(%)+1,1:1)
End DoDot:2
+10 QUIT
End DoDot:1
+11 QUIT
