CIMGAGP ; CMI/TUCSON/LAB - aberdeen area GPRA ; [ 03/16/00 1:55 PM ]
;;1.0;ABERDEEN GPRA REPORT;;JAN 22, 2000
;
;
W:$D(IOF) @IOF
W !!,$$CTR("Aberdeen Area GPRA Report",80)
INTRO ;
D EXIT
;check for community taxonomy
I $G(DUZ(2)) S CIMAREA=$P($G(^AUTTAREA(+$P($G(^AUTTLOC(DUZ(2),0)),U,4),0)),U)
D SU^CIMGAGP0
I $D(CIMQUIT) W !!,"Cannot find community taxonomy" H 4 Q
I $O(CIMTAX(""))="" D GETTAX I $O(CIMTAX(""))="" D EXIT Q
S CIMASUF=$P(^AUTTLOC(DUZ(2),0),U,10)
S CIMSUC=$E(CIMASUF,1,4)
DATES ;
K CIMBD,CIMED,CIMPER
S CIMQTR=0
D Y
I $D(CIMQUIT) D EXIT Q
S CIMQY=""
S DIR(0)="S^Q:One Quarter in FY "_$$FMTE^XLFDT(CIMPER)_";F:Full Fiscal Year",DIR("A")="Run the report for a",DIR("B")="Q" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EXIT Q
S CIMQY=Y
I CIMQY="Q" D Q I $D(CIMQUIT) G DATES
HOME ;
K DIC S DIC="^AUTTLOC(",DIC(0)="AEMQ",DIC("A")="Please enter your HOME Location: " D ^DIC
I Y=-1 W !,"No HOME Location entered!!! PHN Visits counts to Home will be calculated",!,"using clinic 11 only!!" H 2 S CIMHOME="" G LISTS
S CIMHOME=+Y
LISTS ;any lists with indicators?
W !!
S CIMLIST="" K CIMLIST
S T="INDSL" F J=1:1 S X=$T(@T+J),X=$P(X,";;",2) Q:X="END" W !,J,")",?5,X
S DIR(0)="Y",DIR("A")="Should lists be generated for any of the above",DIR("B")="N" KILL DA D ^DIR KILL DIR
I $D(DIRUT)!(Y="") G DATES
I Y=0 G ZIS
K CIMLIST
S DIR(0)="L^1:16",DIR("A")="Which Ones" KILL DA D ^DIR KILL DIR
I $D(DIRUT) G LISTS
F X=1:1 S Z=$P(Y,",",X) Q:Z="" S CIMLIST(Z)=""
ZIS ;call to XBDBQUE
;CREATE REPORT ENTRY IN FILEMAN FILE
K DIC S X=CIMBD,DIC(0)="L",DIC="^CIMAGP(",DLAYGO=19255.01,DIADD=1,DIC("DR")=".02////"_CIMED_";.03////"_CIMPER_";.04///"_CIMQTR_";.05////"_CIMASUF_";.06////"_CIMSUC
D ^DIC K DIC,DA,DR,DIADD,DLAYGO I Y=-1 W !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!" S CIMQUIT=1 D EXIT Q
S CIMRPT=+Y
;add communities to 28 multiple
K ^CIMAGP(CIMRPT,28)
S C=0,X="" F S X=$O(CIMTAX(X)) Q:X="" S C=C+1 S ^CIMAGP(CIMRPT,28,C,0)=X,^CIMAGP(CIMRPT,28,"B",X,C)=""
S ^CIMAGP(CIMRPT,28,0)="^19255.28A^"_C_"^"_C
D ^XBFMK
K DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
W !!,"A file will be created called G",$P(^AUTTLOC(DUZ(2),0),U,10)_"."_CIMRPT,".",!,"It will reside in the public/export directory.",!,"This file should be sent to your Area Office.",!!
S XBRP="PRINT^CIMGAGPP",XBRC="PROC^CIMGAGP1",XBRX="EXIT1^CIMGAGP",XBNS="CIM"
D ^XBDBQUE
D EXIT
Q
;
EXIT1 ;
D ^%ZISC
K IOPAR
D EN^XBNEW("GS^CIMGAGP","CIMRPT")
EXIT ;
D EN^XBVK("CIM")
K X,X1,X2,X3,X4,X5,X6
K A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z
K N,N1,N2,N3,N4,N5,N6
D KILL^AUPNPAT
D ^XBFMK
D HOME^%ZIS
Q
;
SET6 ;
I $G(^CIMAGP(CIMRPT,X,X2,X3,X4,X5,X6))]"" S C=C+1,$P(^CIMGDATA(C),"|")=X,$P(^CIMGDATA(C),"|",2)=X2,$P(^CIMGDATA(C),"|",3)=X3
S $P(^CIMGDATA(C),"|",4)=X4,$P(^CIMGDATA(C),"|",5)=X5,$P(^CIMGDATA(C),"|",6)=X6,$P(^CIMGDATA(C),"|",8)=^CIMAGP(CIMRPT,X,X2,X3,X4,X5,X6)
Q
GS ;EP called from xbnew
K ^CIMGDATA S X="",C=0 F S X=$O(^CIMAGP(CIMRPT,X)) Q:X'=+X D
.I $G(^CIMAGP(CIMRPT,X))]"" S C=C+1,$P(^CIMGDATA(C),"|")=X,$P(^CIMGDATA(C),"|",8)=^CIMAGP(CIMRPT,X)
.S X2="" F S X2=$O(^CIMAGP(CIMRPT,X,X2)) Q:X2'=+X2 D
..I $G(^CIMAGP(CIMRPT,X,X2))]"" S C=C+1,$P(^CIMGDATA(C),"|")=X,$P(^CIMGDATA(C),"|",2)=X2,$P(^CIMGDATA(C),"|",8)=^CIMAGP(CIMRPT,X,X2)
..S X3="" F S X3=$O(^CIMAGP(CIMRPT,X,X2,X3)) Q:X3'=+X3 D
...I $G(^CIMAGP(CIMRPT,X,X2,X3))]"" S C=C+1,$P(^CIMGDATA(C),"|")=X,$P(^CIMGDATA(C),"|",2)=X2,$P(^CIMGDATA(C),"|",3)=X3,$P(^CIMGDATA(C),"|",8)=^CIMAGP(CIMRPT,X,X2,X3)
...S X4="" F S X4=$O(^CIMAGP(CIMRPT,X,X2,X3,X4)) Q:X4'=+X4 D
....I $G(^CIMAGP(CIMRPT,X,X2,X3,X4))]"" S C=C+1,$P(^CIMGDATA(C),"|")=X,$P(^CIMGDATA(C),"|",2)=X2,$P(^CIMGDATA(C),"|",3)=X3,$P(^CIMGDATA(C),"|",4)=X4,$P(^CIMGDATA(C),"|",8)=^CIMAGP(CIMRPT,X,X2,X3,X4)
....S X5="" F S X5=$O(^CIMAGP(CIMRPT,X,X2,X3,X4,X5)) Q:X5'=+X5 D
.....I $G(^CIMAGP(CIMRPT,X,X2,X3,X4,X5))]"" S C=C+1,$P(^CIMGDATA(C),"|")=X,$P(^CIMGDATA(C),"|",2)=X2,$P(^CIMGDATA(C),"|",3)=X3
.....S $P(^CIMGDATA(C),"|",4)=X4,$P(^CIMGDATA(C),"|",5)=X5,$P(^CIMGDATA(C),"|",8)=^CIMAGP(CIMRPT,X,X2,X3,X4,X5)
.....S X6="" F S X6=$O(^CIMAGP(CIMRPT,X,X2,X3,X4,X5,X6)) Q:X6'=+X6 D SET6
S XBGL="CIMGDATA"
S F="G"_$P(^AUTTLOC(DUZ(2),0),U,10)_"."_CIMRPT
S XBMED="F",XBFN=F,XBTLE="SAVE OF GPRA DATA BY - "_$P(^VA(200,DUZ,0),U),XBF=0,XBFLT=1
D ^XBGSAVE
K ^TMP($J),^CIMGDATA
Q
GETTAX ;
K CIMTAX
S CIMTAX=""
D ^XBFMK
S DIC("S")="I $P(^(0),U,15)=9999999.05",DIC="^ATXAX(",DIC(0)="AEMQ",DIC("A")="Enter the Name of the Community Taxonomy: " D ^DIC
I Y=-1 Q
S CIMX=+Y
D SU1^CIMGAGP0
Q
Q ;which quarter
S DIR(0)="N^1:4:0",DIR("A")="Which Quarter" KILL DA D ^DIR KILL DIR
I $D(DIRUT)!(Y="") S CIMQUIT="" Q
S CIMQTR=Y
I Y=1 S CIMBD=($E(CIMPER,1,3)-1)_"1001",CIMED=($E(CIMPER,1,3)-1)_"1231" Q
I Y=2 S CIMBD=$E(CIMPER,1,3)_"0101",CIMED=$E(CIMPER,1,3)_"0331" Q
I Y=3 S CIMBD=$E(CIMPER,1,3)_"0401",CIMED=$E(CIMPER,1,3)_"0630" Q
I Y=4 S CIMBD=$E(CIMPER,1,3)_"0701",CIMED=$E(CIMPER,1,3)_"0930" Q
Q
Y ;fiscal year
W !
S CIMVDT=""
W !,"Enter the FY of interest. Use a 4 digit year, e.g. 1999, 2000"
S DIR(0)="D^::EP"
S DIR("A")="Enter Fiscal year (e.g. 1999)"
S DIR("?")="This report is compiled for a period. Enter a valid date."
D ^DIR
K DIC
If $D(DUOUT) S DIRUT=1 S CIMQUIT="" Q
S CIMVDT=Y
I $E(Y,4,7)'="0000" W !!,"Please enter a year only!",! G Y
S CIMPER=CIMVDT,CIMBD=($E(CIMVDT,1,3)-1)_"1001",CIMED=$E(CIMVDT,1,3)_"0930"
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
EOP ;EP - End of page.
Q:$E(IOST)'="C"
Q:$D(ZTQUEUED)!'(IOT="TRM")!$D(IO("S"))
NEW DIR
K DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
S DIR(0)="E" D ^DIR
Q
;----------
USR() ;EP - Return name of current user from ^VA(200.
Q $S($G(DUZ):$S($D(^VA(200,DUZ,0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
Q $S($G(DUZ(2)):$S($D(^DIC(4,DUZ(2),0)):$P(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
;----------
;
INDSL ;;
;;1/1 Diabetes Prevalance - List of Patients with a Diabetes Diagnosis
;;1/1 Diabetes Incidence - List Patients Newly Diagnoses with Diabetes
;;2/2 Diabetes - List Diabetics and their Glycemic Control
;;3/3 Diabetes - List Diabetics/Hypertensives and their BP
;;4/4 Diabetes - List Diabetics and whether they had a an LDL
;;5/5 Diabetes - List Diabetics and whether they had a Urine Protein
;;6/6 Women's Health - List Women over 17 and whether they had a Pap
;;7/7 Women's Health - List women 49-64 and whether they had a Mammogram
;;8/8 Child Health - List Patients w/ 4 Well Child Visits by 27 months of age
;;11/12 Dental Health - List Patients with Access to Dental Services
;;12/13 Dental Health - List Patients who Received Dental Sealants
;;18/20 Child Health Immunization - List 2 y/o Pts w/ Immunization Status
;;20/23 Child Health - List Obese Children
;;21/2000 Adult Immunizations - List Patients >65 with Pneumovax Status
;;21/2000 Adult Immunizations - List Pts >65 with Flu Shot Status in Past yr
;;24/2000 Smoking Prevalance - List Current Tobacco Users
;;END
CIMGAGP ; CMI/TUCSON/LAB - aberdeen area GPRA ; [ 03/16/00 1:55 PM ]
+1 ;;1.0;ABERDEEN GPRA REPORT;;JAN 22, 2000
+2 ;
+3 ;
+4 IF $DATA(IOF)
WRITE @IOF
+5 WRITE !!,$$CTR("Aberdeen Area GPRA Report",80)
INTRO ;
+1 DO EXIT
+2 ;check for community taxonomy
+3 IF $GET(DUZ(2))
SET CIMAREA=$PIECE($GET(^AUTTAREA(+$PIECE($GET(^AUTTLOC(DUZ(2),0)),U,4),0)),U)
+4 DO SU^CIMGAGP0
+5 IF $DATA(CIMQUIT)
WRITE !!,"Cannot find community taxonomy"
HANG 4
QUIT
+6 IF $ORDER(CIMTAX(""))=""
DO GETTAX
IF $ORDER(CIMTAX(""))=""
DO EXIT
QUIT
+7 SET CIMASUF=$PIECE(^AUTTLOC(DUZ(2),0),U,10)
+8 SET CIMSUC=$EXTRACT(CIMASUF,1,4)
DATES ;
+1 KILL CIMBD,CIMED,CIMPER
+2 SET CIMQTR=0
+3 DO Y
+4 IF $DATA(CIMQUIT)
DO EXIT
QUIT
+5 SET CIMQY=""
+6 SET DIR(0)="S^Q:One Quarter in FY "_$$FMTE^XLFDT(CIMPER)_";F:Full Fiscal Year"
SET DIR("A")="Run the report for a"
SET DIR("B")="Q"
KILL DA
DO ^DIR
KILL DIR
+7 IF $DATA(DIRUT)
DO EXIT
QUIT
+8 SET CIMQY=Y
+9 IF CIMQY="Q"
DO Q
IF $DATA(CIMQUIT)
GOTO DATES
HOME ;
+1 KILL DIC
SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
SET DIC("A")="Please enter your HOME Location: "
DO ^DIC
+2 IF Y=-1
WRITE !,"No HOME Location entered!!! PHN Visits counts to Home will be calculated",!,"using clinic 11 only!!"
HANG 2
SET CIMHOME=""
GOTO LISTS
+3 SET CIMHOME=+Y
LISTS ;any lists with indicators?
+1 WRITE !!
+2 SET CIMLIST=""
KILL CIMLIST
+3 SET T="INDSL"
FOR J=1:1
SET X=$TEXT(@T+J)
SET X=$PIECE(X,";;",2)
IF X="END"
QUIT
WRITE !,J,")",?5,X
+4 SET DIR(0)="Y"
SET DIR("A")="Should lists be generated for any of the above"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+5 IF $DATA(DIRUT)!(Y="")
GOTO DATES
+6 IF Y=0
GOTO ZIS
+7 KILL CIMLIST
+8 SET DIR(0)="L^1:16"
SET DIR("A")="Which Ones"
KILL DA
DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
GOTO LISTS
+10 FOR X=1:1
SET Z=$PIECE(Y,",",X)
IF Z=""
QUIT
SET CIMLIST(Z)=""
ZIS ;call to XBDBQUE
+1 ;CREATE REPORT ENTRY IN FILEMAN FILE
+2 KILL DIC
SET X=CIMBD
SET DIC(0)="L"
SET DIC="^CIMAGP("
SET DLAYGO=19255.01
SET DIADD=1
SET DIC("DR")=".02////"_CIMED_";.03////"_CIMPER_";.04///"_CIMQTR_";.05////"_CIMASUF_";.06////"_CIMSUC
+3 DO ^DIC
KILL DIC,DA,DR,DIADD,DLAYGO
IF Y=-1
WRITE !!,"UNABLE TO CREATE REPORT FILE ENTRY - NOTIFY SITE MANAGER!"
SET CIMQUIT=1
DO EXIT
QUIT
+4 SET CIMRPT=+Y
+5 ;add communities to 28 multiple
+6 KILL ^CIMAGP(CIMRPT,28)
+7 SET C=0
SET X=""
FOR
SET X=$ORDER(CIMTAX(X))
IF X=""
QUIT
SET C=C+1
SET ^CIMAGP(CIMRPT,28,C,0)=X
SET ^CIMAGP(CIMRPT,28,"B",X,C)=""
+8 SET ^CIMAGP(CIMRPT,28,0)="^19255.28A^"_C_"^"_C
+9 DO ^XBFMK
+10 KILL DIC,DIADD,DLAYGO,DR,DA,DD,X,Y,DINUM
+11 WRITE !!,"A file will be created called G",$PIECE(^AUTTLOC(DUZ(2),0),U,10)_"."_CIMRPT,".",!,"It will reside in the public/export directory.",!,"This file should be sent to your Area Office.",!!
+12 SET XBRP="PRINT^CIMGAGPP"
SET XBRC="PROC^CIMGAGP1"
SET XBRX="EXIT1^CIMGAGP"
SET XBNS="CIM"
+13 DO ^XBDBQUE
+14 DO EXIT
+15 QUIT
+16 ;
EXIT1 ;
+1 DO ^%ZISC
+2 KILL IOPAR
+3 DO EN^XBNEW("GS^CIMGAGP","CIMRPT")
EXIT ;
+1 DO EN^XBVK("CIM")
+2 KILL X,X1,X2,X3,X4,X5,X6
+3 KILL A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,V,W,X,Y,Z
+4 KILL N,N1,N2,N3,N4,N5,N6
+5 DO KILL^AUPNPAT
+6 DO ^XBFMK
+7 DO HOME^%ZIS
+8 QUIT
+9 ;
SET6 ;
+1 IF $GET(^CIMAGP(CIMRPT,X,X2,X3,X4,X5,X6))]""
SET C=C+1
SET $PIECE(^CIMGDATA(C),"|")=X
SET $PIECE(^CIMGDATA(C),"|",2)=X2
SET $PIECE(^CIMGDATA(C),"|",3)=X3
+2 SET $PIECE(^CIMGDATA(C),"|",4)=X4
SET $PIECE(^CIMGDATA(C),"|",5)=X5
SET $PIECE(^CIMGDATA(C),"|",6)=X6
SET $PIECE(^CIMGDATA(C),"|",8)=^CIMAGP(CIMRPT,X,X2,X3,X4,X5,X6)
+3 QUIT
GS ;EP called from xbnew
+1 KILL ^CIMGDATA
SET X=""
SET C=0
FOR
SET X=$ORDER(^CIMAGP(CIMRPT,X))
IF X'=+X
QUIT
Begin DoDot:1
+2 IF $GET(^CIMAGP(CIMRPT,X))]""
SET C=C+1
SET $PIECE(^CIMGDATA(C),"|")=X
SET $PIECE(^CIMGDATA(C),"|",8)=^CIMAGP(CIMRPT,X)
+3 SET X2=""
FOR
SET X2=$ORDER(^CIMAGP(CIMRPT,X,X2))
IF X2'=+X2
QUIT
Begin DoDot:2
+4 IF $GET(^CIMAGP(CIMRPT,X,X2))]""
SET C=C+1
SET $PIECE(^CIMGDATA(C),"|")=X
SET $PIECE(^CIMGDATA(C),"|",2)=X2
SET $PIECE(^CIMGDATA(C),"|",8)=^CIMAGP(CIMRPT,X,X2)
+5 SET X3=""
FOR
SET X3=$ORDER(^CIMAGP(CIMRPT,X,X2,X3))
IF X3'=+X3
QUIT
Begin DoDot:3
+6 IF $GET(^CIMAGP(CIMRPT,X,X2,X3))]""
SET C=C+1
SET $PIECE(^CIMGDATA(C),"|")=X
SET $PIECE(^CIMGDATA(C),"|",2)=X2
SET $PIECE(^CIMGDATA(C),"|",3)=X3
SET $PIECE(^CIMGDATA(C),"|",8)=^CIMAGP(CIMRPT,X,X2,X3)
+7 SET X4=""
FOR
SET X4=$ORDER(^CIMAGP(CIMRPT,X,X2,X3,X4))
IF X4'=+X4
QUIT
Begin DoDot:4
+8 IF $GET(^CIMAGP(CIMRPT,X,X2,X3,X4))]""
SET C=C+1
SET $PIECE(^CIMGDATA(C),"|")=X
SET $PIECE(^CIMGDATA(C),"|",2)=X2
SET $PIECE(^CIMGDATA(C),"|",3)=X3
SET $PIECE(^CIMGDATA(C),"|",4)=X4
SET $PIECE(^CIMGDATA(C),"|",8)=^CIMAGP(CIMRPT,X,X2,X3,X4)
+9 SET X5=""
FOR
SET X5=$ORDER(^CIMAGP(CIMRPT,X,X2,X3,X4,X5))
IF X5'=+X5
QUIT
Begin DoDot:5
+10 IF $GET(^CIMAGP(CIMRPT,X,X2,X3,X4,X5))]""
SET C=C+1
SET $PIECE(^CIMGDATA(C),"|")=X
SET $PIECE(^CIMGDATA(C),"|",2)=X2
SET $PIECE(^CIMGDATA(C),"|",3)=X3
+11 SET $PIECE(^CIMGDATA(C),"|",4)=X4
SET $PIECE(^CIMGDATA(C),"|",5)=X5
SET $PIECE(^CIMGDATA(C),"|",8)=^CIMAGP(CIMRPT,X,X2,X3,X4,X5)
+12 SET X6=""
FOR
SET X6=$ORDER(^CIMAGP(CIMRPT,X,X2,X3,X4,X5,X6))
IF X6'=+X6
QUIT
DO SET6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 SET XBGL="CIMGDATA"
+14 SET F="G"_$PIECE(^AUTTLOC(DUZ(2),0),U,10)_"."_CIMRPT
+15 SET XBMED="F"
SET XBFN=F
SET XBTLE="SAVE OF GPRA DATA BY - "_$PIECE(^VA(200,DUZ,0),U)
SET XBF=0
SET XBFLT=1
+16 DO ^XBGSAVE
+17 KILL ^TMP($JOB),^CIMGDATA
+18 QUIT
GETTAX ;
+1 KILL CIMTAX
+2 SET CIMTAX=""
+3 DO ^XBFMK
+4 SET DIC("S")="I $P(^(0),U,15)=9999999.05"
SET DIC="^ATXAX("
SET DIC(0)="AEMQ"
SET DIC("A")="Enter the Name of the Community Taxonomy: "
DO ^DIC
+5 IF Y=-1
QUIT
+6 SET CIMX=+Y
+7 DO SU1^CIMGAGP0
+8 QUIT
Q ;which quarter
+1 SET DIR(0)="N^1:4:0"
SET DIR("A")="Which Quarter"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)!(Y="")
SET CIMQUIT=""
QUIT
+3 SET CIMQTR=Y
+4 IF Y=1
SET CIMBD=($EXTRACT(CIMPER,1,3)-1)_"1001"
SET CIMED=($EXTRACT(CIMPER,1,3)-1)_"1231"
QUIT
+5 IF Y=2
SET CIMBD=$EXTRACT(CIMPER,1,3)_"0101"
SET CIMED=$EXTRACT(CIMPER,1,3)_"0331"
QUIT
+6 IF Y=3
SET CIMBD=$EXTRACT(CIMPER,1,3)_"0401"
SET CIMED=$EXTRACT(CIMPER,1,3)_"0630"
QUIT
+7 IF Y=4
SET CIMBD=$EXTRACT(CIMPER,1,3)_"0701"
SET CIMED=$EXTRACT(CIMPER,1,3)_"0930"
QUIT
+8 QUIT
Y ;fiscal year
+1 WRITE !
+2 SET CIMVDT=""
+3 WRITE !,"Enter the FY of interest. Use a 4 digit year, e.g. 1999, 2000"
+4 SET DIR(0)="D^::EP"
+5 SET DIR("A")="Enter Fiscal year (e.g. 1999)"
+6 SET DIR("?")="This report is compiled for a period. Enter a valid date."
+7 DO ^DIR
+8 KILL DIC
+9 IF $DATA(DUOUT)
SET DIRUT=1
SET CIMQUIT=""
QUIT
+10 SET CIMVDT=Y
+11 IF $EXTRACT(Y,4,7)'="0000"
WRITE !!,"Please enter a year only!",!
GOTO Y
+12 SET CIMPER=CIMVDT
SET CIMBD=($EXTRACT(CIMVDT,1,3)-1)_"1001"
SET CIMED=$EXTRACT(CIMVDT,1,3)_"0930"
+13 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
EOP ;EP - End of page.
+1 IF $EXTRACT(IOST)'="C"
QUIT
+2 IF $DATA(ZTQUEUED)!'(IOT="TRM")!$DATA(IO("S"))
QUIT
+3 NEW DIR
+4 KILL DIRUT,DFOUT,DLOUT,DTOUT,DUOUT
+5 SET DIR(0)="E"
DO ^DIR
+6 QUIT
+7 ;----------
USR() ;EP - Return name of current user from ^VA(200.
+1 QUIT $SELECT($GET(DUZ):$SELECT($DATA(^VA(200,DUZ,0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ UNDEFINED OR 0")
+2 ;----------
LOC() ;EP - Return location name from file 4 based on DUZ(2).
+1 QUIT $SELECT($GET(DUZ(2)):$SELECT($DATA(^DIC(4,DUZ(2),0)):$PIECE(^(0),U),1:"UNKNOWN"),1:"DUZ(2) UNDEFINED OR 0")
+2 ;----------
+3 ;
INDSL ;;
+1 ;;1/1 Diabetes Prevalance - List of Patients with a Diabetes Diagnosis
+2 ;;1/1 Diabetes Incidence - List Patients Newly Diagnoses with Diabetes
+3 ;;2/2 Diabetes - List Diabetics and their Glycemic Control
+4 ;;3/3 Diabetes - List Diabetics/Hypertensives and their BP
+5 ;;4/4 Diabetes - List Diabetics and whether they had a an LDL
+6 ;;5/5 Diabetes - List Diabetics and whether they had a Urine Protein
+7 ;;6/6 Women's Health - List Women over 17 and whether they had a Pap
+8 ;;7/7 Women's Health - List women 49-64 and whether they had a Mammogram
+9 ;;8/8 Child Health - List Patients w/ 4 Well Child Visits by 27 months of age
+10 ;;11/12 Dental Health - List Patients with Access to Dental Services
+11 ;;12/13 Dental Health - List Patients who Received Dental Sealants
+12 ;;18/20 Child Health Immunization - List 2 y/o Pts w/ Immunization Status
+13 ;;20/23 Child Health - List Obese Children
+14 ;;21/2000 Adult Immunizations - List Patients >65 with Pneumovax Status
+15 ;;21/2000 Adult Immunizations - List Pts >65 with Flu Shot Status in Past yr
+16 ;;24/2000 Smoking Prevalance - List Current Tobacco Users
+17 ;;END
