APCLCH1 ; IHS/CMI/LAB - COMMUNITY HEALTH PROFILE ;
;;2.0;IHS PCC SUITE;**2,7**;MAY 14, 2009
;
;
START ;
S APCLJOB=$J,APCLBTH=$H
K ^XTMP("APCLCH1",APCLJOB,APCLBTH)
D XTMP^APCLOSUT("APCLCH1","PCC - COMMUNITY HEALTH PROFILE")
D INFORM
SU S B=$P(^AUTTLOC(DUZ(2),0),U,5) I B S S=$P(^AUTTSU(B,0),U),DIC("A")="Please Identify your Service Unit: "_S_"//"
S DIC="^AUTTSU(",DIC(0)="AEMQZ" W ! D ^DIC K DIC
I X="^" G XIT
I X="" S (APCLSU,APCLSUF)=B G GETDATES
G:Y=-1 GETDATES
S (APCLSU,APCLSUF)=+Y
GETDATES ;
BD ;
W !!,"Enter the time frame of interest.",! S DIR(0)="D^::EP",DIR("A")="Enter Beginning Visit Date",DIR("?")="Enter the beginning visit date for the search." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) XIT
S APCLBD=Y
ED ;
S DIR(0)="DA^::EP",DIR("A")="Enter Ending Visit Date: " D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) XIT
I Y<APCLBD W !,"Ending date must be greater than or equal to beginning date!" G ED
S APCLED=Y
S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X
COMM ;
S APCLCOMT="" K APCLQUIT,^XTMP("APCLCH1",APCLJOB,APCLBTH,"COMMUNITIES")
K DIR S DIR(0)="S^O:ONE Particular Community;S:All Communities within the "_$P(^AUTTSU(APCLSU,0),U)_" SERVICE UNIT;T:A TAXONOMY or selected set of Communities"
S DIR("A")="Enter a code indicating what COMMUNITIES of RESIDENCE are of interest",DIR("B")="O" K DA D ^DIR K DIR,DA
G:$D(DIRUT) GETDATES
S APCLCOMT=Y
D @APCLCOMT
G:$D(APCLQUIT) COMM
ST ;;template of patients?
S APCLSEAT=""
S DIR(0)="S^A:ALL PATIENTS;S:SEARCH TEMPLATE OF PATIENTS",DIR("A")="Include which patients in the tally of diagnoses",DIR("B")="A" KILL DA D ^DIR KILL DIR
G:$D(DIRUT) COMM
I Y="A" G ZIS
S APCLSEAT=""
;
W ! S DIC("S")="I $P(^(0),U,4)=9000001" S DIC="^DIBT(",DIC("A")="Enter Patient SEARCH TEMPLATE name: ",DIC(0)="AEMQ" D ^DIC K DIC,DA,DR,DICR
I Y=-1 S APCLSEAT="" G ST
S APCLSEAT=+Y
ZIS ;
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G COMM
S XBRP="^APCLCH1P",XBRC="^APCLCH11",XBNS="APCL",XBRX="XIT^APCLCH1"
D ^XBDBQUE
Q
;
XIT ;
K APCLQUIT,APCLCOMT,APCLBD,APCLED,APCLDFN,APCLSD,APCLX,APCLY,APCLER,APCL1,APCL2,APCL3,APCL4,APCLAGEP,APCLC,APCLCOMI,APCLLCOM,APCLMDFN,APCLSCOM,APCLSU,APCLSUF,APCLVAL
D KILL^AUPNPAT
D ^XBFMK
Q
O ;one community
S DIC="^AUTTCOM(",DIC(0)="AEMQ",DIC("A")="Which COMMUNITY: " D ^DIC K DIC
I Y=-1 S APCLQUIT="" Q
S ^XTMP("APCLCH1",APCLJOB,APCLBTH,"COMMUNITIES",$P(^AUTTCOM(+Y,0),U))=""
Q
S ;all communities within APCLSU su
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,"COMMUNITIES",$P(^AUTTCOM(X,0),U))=""
Q
;
T ;taxonomy - call qman interface
K APCLCOMM
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" G XIT
D PEP^AMQQGTX0(+Y,"APCLCOMM(")
I '$D(APCLCOMM) G COMM
I $D(APCLCOMM("*")) K APCLCOMM,^XTMP("APCLCH1",APCLJOB,APCLBTH,"COMMUNITIES") W !!,$C(7),$C(7),"ALL communities is NOT an option with this report",! G T
S X="" F S X=$O(APCLCOMM(X)) Q:X="" S ^XTMP("APCLCH1",APCLJOB,APCLBTH,"COMMUNITIES",X)=""
K APCLCOMM
Q
INFORM ;tell user what is going on
;
W:$D(IOF) @IOF
W !!?10,"************* COMMUNITY HEALTH PROFILE ************"
W !!,"This report will present a profile of health care for patients who reside in a",!,"community or communities that you select. You will be asked to enter a date",!,"range and to identify the communities of interest.",!!
Q
SET ;EP - ENTRY POINT
S APCLC="" F S APCLC=$O(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLC)) Q:APCLC="" D
.S APCL4="REPORT",APCL1="OUTDXC",APCL3="OUTDX" D SET1
.S APCL4="REPORT",APCL1="INDXC",APCL3="INDX" D SET1
.S APCL4="REPORT",APCL1="INJC",APCL3="INJ" D SET1
.S APCL4="REPORT",APCL1="DENTALC",APCL3="DENT" D SET1
.S APCL4="REPORT",APCL1="SURG PROCC",APCL3="SURG PROC" D SET1
D SETSU
Q
SET1 ;
S APCL2="^XTMP(""APCLCH1"",APCLJOB,APCLBTH,""RP"","""_APCLC_""","""_APCL4_""","""_APCL3_""",X)"
S X="" F S X=$O(@APCL2) Q:X="" S %=^(X) S ^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLC,APCL4,APCL1,9999999-%,X)=%
Q
SETSU ;
S APCL4="SU",APCL1="OUTDXC",APCL3="OUTDX" D SETSU1
S APCL4="SU",APCL1="INDXC",APCL3="INDX" D SETSU1
S APCL4="SU",APCL1="INJC",APCL3="INJ" D SETSU1
S APCL4="SU",APCL1="DENTALC",APCL3="DENT" D SETSU1
S APCL4="SU",APCL1="SURG PROCC",APCL3="SURG PROC" D SETSU1
Q
SETSU1 ;
S APCL2="^XTMP(""APCLCH1"",APCLJOB,APCLBTH,"""_APCL4_""","""_APCL3_""",X)"
S X="" F S X=$O(@APCL2) Q:X="" S %=^(X) S ^XTMP("APCLCH1",APCLJOB,APCLBTH,APCL4,APCL1,9999999-%,X)=%
Q
APCLCH1 ; IHS/CMI/LAB - COMMUNITY HEALTH PROFILE ;
+1 ;;2.0;IHS PCC SUITE;**2,7**;MAY 14, 2009
+2 ;
+3 ;
START ;
+1 SET APCLJOB=$JOB
SET APCLBTH=$HOROLOG
+2 KILL ^XTMP("APCLCH1",APCLJOB,APCLBTH)
+3 DO XTMP^APCLOSUT("APCLCH1","PCC - COMMUNITY HEALTH PROFILE")
+4 DO INFORM
SU SET B=$PIECE(^AUTTLOC(DUZ(2),0),U,5)
IF B
SET S=$PIECE(^AUTTSU(B,0),U)
SET DIC("A")="Please Identify your Service Unit: "_S_"//"
+1 SET DIC="^AUTTSU("
SET DIC(0)="AEMQZ"
WRITE !
DO ^DIC
KILL DIC
+2 IF X="^"
GOTO XIT
+3 IF X=""
SET (APCLSU,APCLSUF)=B
GOTO GETDATES
+4 IF Y=-1
GOTO GETDATES
+5 SET (APCLSU,APCLSUF)=+Y
GETDATES ;
BD ;
+1 WRITE !!,"Enter the time frame of interest.",!
SET DIR(0)="D^::EP"
SET DIR("A")="Enter Beginning Visit Date"
SET DIR("?")="Enter the beginning visit date for the search."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO XIT
+3 SET APCLBD=Y
ED ;
+1 SET DIR(0)="DA^::EP"
SET DIR("A")="Enter Ending Visit Date: "
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO XIT
+3 IF Y<APCLBD
WRITE !,"Ending date must be greater than or equal to beginning date!"
GOTO ED
+4 SET APCLED=Y
+5 SET X1=APCLBD
SET X2=-1
DO C^%DTC
SET APCLSD=X
COMM ;
+1 SET APCLCOMT=""
KILL APCLQUIT,^XTMP("APCLCH1",APCLJOB,APCLBTH,"COMMUNITIES")
+2 KILL DIR
SET DIR(0)="S^O:ONE Particular Community;S:All Communities within the "_$PIECE(^AUTTSU(APCLSU,0),U)_" SERVICE UNIT;T:A TAXONOMY or selected set of Communities"
+3 SET DIR("A")="Enter a code indicating what COMMUNITIES of RESIDENCE are of interest"
SET DIR("B")="O"
KILL DA
DO ^DIR
KILL DIR,DA
+4 IF $DATA(DIRUT)
GOTO GETDATES
+5 SET APCLCOMT=Y
+6 DO @APCLCOMT
+7 IF $DATA(APCLQUIT)
GOTO COMM
ST ;;template of patients?
+1 SET APCLSEAT=""
+2 SET DIR(0)="S^A:ALL PATIENTS;S:SEARCH TEMPLATE OF PATIENTS"
SET DIR("A")="Include which patients in the tally of diagnoses"
SET DIR("B")="A"
KILL DA
DO ^DIR
KILL DIR
+3 IF $DATA(DIRUT)
GOTO COMM
+4 IF Y="A"
GOTO ZIS
+5 SET APCLSEAT=""
+6 ;
+7 WRITE !
SET DIC("S")="I $P(^(0),U,4)=9000001"
SET DIC="^DIBT("
SET DIC("A")="Enter Patient SEARCH TEMPLATE name: "
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA,DR,DICR
+8 IF Y=-1
SET APCLSEAT=""
GOTO ST
+9 SET APCLSEAT=+Y
ZIS ;
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO COMM
+3 SET XBRP="^APCLCH1P"
SET XBRC="^APCLCH11"
SET XBNS="APCL"
SET XBRX="XIT^APCLCH1"
+4 DO ^XBDBQUE
+5 QUIT
+6 ;
XIT ;
+1 KILL APCLQUIT,APCLCOMT,APCLBD,APCLED,APCLDFN,APCLSD,APCLX,APCLY,APCLER,APCL1,APCL2,APCL3,APCL4,APCLAGEP,APCLC,APCLCOMI,APCLLCOM,APCLMDFN,APCLSCOM,APCLSU,APCLSUF,APCLVAL
+2 DO KILL^AUPNPAT
+3 DO ^XBFMK
+4 QUIT
O ;one community
+1 SET DIC="^AUTTCOM("
SET DIC(0)="AEMQ"
SET DIC("A")="Which COMMUNITY: "
DO ^DIC
KILL DIC
+2 IF Y=-1
SET APCLQUIT=""
QUIT
+3 SET ^XTMP("APCLCH1",APCLJOB,APCLBTH,"COMMUNITIES",$PIECE(^AUTTCOM(+Y,0),U))=""
+4 QUIT
S ;all communities within APCLSU su
+1 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,"COMMUNITIES",$PIECE(^AUTTCOM(X,0),U))=""
+2 QUIT
+3 ;
T ;taxonomy - call qman interface
+1 KILL APCLCOMM
+2 SET X="COMMUNITY"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
GOTO XIT
+3 DO PEP^AMQQGTX0(+Y,"APCLCOMM(")
+4 IF '$DATA(APCLCOMM)
GOTO COMM
+5 IF $DATA(APCLCOMM("*"))
KILL APCLCOMM,^XTMP("APCLCH1",APCLJOB,APCLBTH,"COMMUNITIES")
WRITE !!,$CHAR(7),$CHAR(7),"ALL communities is NOT an option with this report",!
GOTO T
+6 SET X=""
FOR
SET X=$ORDER(APCLCOMM(X))
IF X=""
QUIT
SET ^XTMP("APCLCH1",APCLJOB,APCLBTH,"COMMUNITIES",X)=""
+7 KILL APCLCOMM
+8 QUIT
INFORM ;tell user what is going on
+1 ;
+2 IF $DATA(IOF)
WRITE @IOF
+3 WRITE !!?10,"************* COMMUNITY HEALTH PROFILE ************"
+4 WRITE !!,"This report will present a profile of health care for patients who reside in a",!,"community or communities that you select. You will be asked to enter a date",!,"range and to identify the communities of interest.",!!
+5 QUIT
SET ;EP - ENTRY POINT
+1 SET APCLC=""
FOR
SET APCLC=$ORDER(^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLC))
IF APCLC=""
QUIT
Begin DoDot:1
+2 SET APCL4="REPORT"
SET APCL1="OUTDXC"
SET APCL3="OUTDX"
DO SET1
+3 SET APCL4="REPORT"
SET APCL1="INDXC"
SET APCL3="INDX"
DO SET1
+4 SET APCL4="REPORT"
SET APCL1="INJC"
SET APCL3="INJ"
DO SET1
+5 SET APCL4="REPORT"
SET APCL1="DENTALC"
SET APCL3="DENT"
DO SET1
+6 SET APCL4="REPORT"
SET APCL1="SURG PROCC"
SET APCL3="SURG PROC"
DO SET1
End DoDot:1
+7 DO SETSU
+8 QUIT
SET1 ;
+1 SET APCL2="^XTMP(""APCLCH1"",APCLJOB,APCLBTH,""RP"","""_APCLC_""","""_APCL4_""","""_APCL3_""",X)"
+2 SET X=""
FOR
SET X=$ORDER(@APCL2)
IF X=""
QUIT
SET %=^(X)
SET ^XTMP("APCLCH1",APCLJOB,APCLBTH,"RP",APCLC,APCL4,APCL1,9999999-%,X)=%
+3 QUIT
SETSU ;
+1 SET APCL4="SU"
SET APCL1="OUTDXC"
SET APCL3="OUTDX"
DO SETSU1
+2 SET APCL4="SU"
SET APCL1="INDXC"
SET APCL3="INDX"
DO SETSU1
+3 SET APCL4="SU"
SET APCL1="INJC"
SET APCL3="INJ"
DO SETSU1
+4 SET APCL4="SU"
SET APCL1="DENTALC"
SET APCL3="DENT"
DO SETSU1
+5 SET APCL4="SU"
SET APCL1="SURG PROCC"
SET APCL3="SURG PROC"
DO SETSU1
+6 QUIT
SETSU1 ;
+1 SET APCL2="^XTMP(""APCLCH1"",APCLJOB,APCLBTH,"""_APCL4_""","""_APCL3_""",X)"
+2 SET X=""
FOR
SET X=$ORDER(@APCL2)
IF X=""
QUIT
SET %=^(X)
SET ^XTMP("APCLCH1",APCLJOB,APCLBTH,APCL4,APCL1,9999999-%,X)=%
+3 QUIT
