- 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
