ACHSRELG ;IHS/OIT/FCJ - Eligibility population Report by Tribe and FY
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
;ACHS*3.1*18 new routine
;Eligibility population report by TRIBAL CHSDA and FY
ST ;
S ACHSIO=IO
W !!,"This is a CHS population report based on Tribal CHSDA,"
W !,"community of residence and Fiscal Year."
W !,"The CHS Service Delivery Area is entered by county,"
W !,"then checked against the patient's community of residence."
W !!,"NOTE: If all counties are not listed for selected Tribal CHSDA"
W !,"use the option SDA Enter/Edit Tribal CHSDA to update counties"
;
FY ; Select FY.
S ACHSACFY=$$FYSEL^ACHS(1)
G:$D(DTOUT)!$D(DUOUT) EXT
I '$D(^ACHS(9,DUZ(2),"FY",ACHSACFY)) W !!,*7,"Fiscal year '",ACHSACFY,"' does not exist. -- TRY AGAIN" G FY
FYDT ;BEG AND END DATES FOR THE FY, DOS >ACHSBFY OR <ACHSEFY
I $P(^ACHSF(DUZ(2),0),U,7)=1 S ACHSBFY=ACHSACFY-1701_($P(^ACHSF(DUZ(2),0),U,6)-1),ACHSEFY=ACHSACFY-1700_($P(^ACHSF(DUZ(2),0),U,6)-1)
E S ACHSBFY=ACHSACFY-1700_($P(^ACHSF(DUZ(2),0),U,6)-1),ACHSEFY=ACHSACFY-1699_($P(^ACHSF(DUZ(2),0),U,6)-1)
;
TRB ;Tribal CHSDA
;
W !
S DIC="^ACHSSDA(",DIC(0)="AEQM"
S DIC("A")="Enter the Tribal CHSDA: "
D ^DIC
I +Y<0 G FY
S ACHSSDA=+Y
;
TYPE ; TYPE OF REPORT SUMARRY OR DETAILED
; Enter Summary or Detail
S DIR(0)="S^S:SUMMARY;D:DETAILED",DIR("A")="Report Type ",DIR("B")="SUMMARY"
S DIR("?")="Detail will display indiviual PO, Summary will display only the totals"
D ^DIR
G EXT:$D(DUOUT),EXT:$D(DTOUT),EXT:$D(DIROUT)
S ACHSRTYP=Y
DEV ; Select device for report.
S %=$$PB^ACHS
I %=U!$D(DTOUT)!$D(DUOUT) G EXT
I %="B" D VIEWR^XBLM("A1^ACHSRELG"),EN^XBVK("VALM") G EXT
K IOP,%ZIS
S %ZIS="PQ"
D ^%ZIS,SLV^ACHSFU:$D(IO("S"))
K %ZIS
I POP W !,*7,"No device specified." D HOME^%ZIS G EXT
G:'$D(IO("Q")) A1
K IO("Q")
I $E(IOST)'="P" W *7,!,"Please queue to printers only." G DEV
S ZTIO="",ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL,ZTRTN="A1^ACHSRGPR",ZTDESC="CHS GPRA Report, "_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT)
F %="ACHSQIO","ACHSBDT","ACHSEDT","ACHSRTYP","ACHSACFY","ACHSEFY","ACHSBFY","ACHSSDA" S ZTSAVE(%)=""
D ^%ZTLOAD
G:'$D(ZTSK) DEV
;
;end of interactive portion. The rest performed by Taskman
;
A1 ;EP - TaskMan.
D FC^ACHSUF
I $D(ACHSERR),ACHSERR=1 G EXT
K ^TMP("ACHSRELG",$J)
S ^TMP("ACHSRELG",$J,"TOTELG")=0
S ACHSTRC=$P(^AUTTTRI($P(^ACHSSDA(ACHSSDA,0),U),0),U)
;
CNTY ;SET COUNTY AND COMMUNITY CODES IN TMP GLB
S ACHSCNTY=0
F S ACHSCNTY=$O(^ACHSSDA(ACHSSDA,30,ACHSCNTY)) Q:ACHSCNTY'?1N.N D
.S ACHSCST=$P(^AUTTCTY($P(^ACHSSDA(ACHSSDA,30,ACHSCNTY,0),U),0),U,4)
.S ^TMP("ACHSRELG",$J,"CNTY",ACHSCST,0)=0
.S ACHSCOM=ACHSCST_"000",ACHSCOMT=ACHSCST_999
.F S ACHSCOM=$O(^AUTTCOM("C",ACHSCOM)) Q:(ACHSCOM="")!(ACHSCOM>ACHSCOMT) D
..S ^TMP("ACHSRELG",$J,"CNTY",ACHSCST,ACHSCOM)=0
..S ACHSCOMP=$O(^AUTTCOM("C",ACHSCOM,0))
..S ^TMP("ACHSRELG",$J,"COM",ACHSCOMP)=ACHSCOM
;
REG ;CHECK PAT FOR CURRENT COM
;TEST FOR NON-INDIAN BENEFICIARY, NON-INDIAN MEMBER OF IND. HOUSEHOLD AND UNSPECIFIED
S ACHSTCD1=$O(^AUTTTRI("C","000",0)),ACHSTCD2=$O(^AUTTTRI("C",970,0)),ACHSTCD3=$O(^AUTTTRI("C",999,0))
S ACHSPAT=0,ACHSCT=0
F S ACHSPAT=$O(^AUPNPAT(ACHSPAT)) Q:ACHSPAT'?1N.N D
.S ACHSCT=ACHSCT+1 I '$D(ZTQUEUED),ACHSCT#1000=0 W "."
.;TEST TRIBAL ENROLLMENT
.Q:'$D(^AUPNPAT(ACHSPAT,11))
.S ACHSTRB=$P(^AUPNPAT(ACHSPAT,11),U,8)
.Q:(ACHSTRB=ACHSTCD1)!(ACHSTRB=ACHSTCD2)!(ACHSTRB=ACHSTCD3)!(ACHSTRB="")
.;TEST FOR DATE OF DEATH, QUIT IF DATE IS < BEG DATE OF FY
.I $D(^DPT(ACHSPAT,.35)) Q:$P(^DPT(ACHSPAT,.35),U)<ACHSBFY
.;TEST FOR CURRENT COMMUNITY AND DATE MOVE < THE LAST DAY OF THE FY
.S ACHSCOMP=$P(^AUPNPAT(ACHSPAT,11),U,17),ACHSCCDT=$P(^(11),U,13)
.Q:'ACHSCOMP
.I $D(^TMP("ACHSRELG",$J,"COM",ACHSCOMP)),ACHSCCDT<ACHSEFY D SET Q
.;THEN TEST PREVIOUS COMMUNITY FOR DATES WITH IN SELECTED FY
.I $D(^AUPNPAT(ACHSPAT,51)) S ACHSQUIT=0 D
..S L=0 F S L=$O(^AUPNPAT(ACHSPAT,51,L)) Q:L'?1N.N D Q:ACHSQUIT=1
...Q:L>ACHSEFY
...S ACHSCOMP=$P(^AUPNPAT(ACHSPAT,51,L,0),U,3)
...I ACHSCOMP,$D(^TMP("ACHSRELG",$J,"COM",ACHSCOMP)),(L>ACHSBFY&L<ACHSEFY) D SET S ACHSQUIT=1 Q
...I ACHSCOMP,$D(^TMP("ACHSRELG",$J,"COM",ACHSCOMP)),L<ACHSBFY D
....S L1=L,L1=$O(^AUPNPAT(ACHSPAT,51,L1)) I L1="" D SET S ACHSQUIT=1 Q
....I L1>ACHSBFY,L1<ACHSEFY D SET S ACHSQUIT=1 Q
D PRINT
;
EXT ; Kill vars, close device, quit.
I $D(IO("S")) X ACHSPPC
E D ^%ZISC
D EN^XBVK("ACHS"),^ACHSVAR:'$D(ZTQUEUED)
K ^TMP("ACHSRELG",$J)
K DTOUT,DUOUT,ZTSK
Q
;
SET ;SET THE DATA FOR ELIG PATIENT
;
S ACHSCOM=^TMP("ACHSRELG",$J,"COM",ACHSCOMP),ACHSCST=$E(ACHSCOM,1,4)
S ^TMP("ACHSRELG",$J,"CNTY",ACHSCST,ACHSCOM)=^TMP("ACHSRELG",$J,"CNTY",ACHSCST,ACHSCOM)+1
S ^TMP("ACHSRELG",$J,"CNTY",ACHSCST,0)=^TMP("ACHSRELG",$J,"CNTY",ACHSCST,0)+1
S ^TMP("ACHSRELG",$J,"TOTELG")=^TMP("ACHSRELG",$J,"TOTELG")+1
;Q:ACHSRTYP="S"
S ^TMP("ACHSRELG",$J,"CNTY","T",ACHSCST,$P(^AUTTTRI(ACHSTRB,0),U),$P(^DPT(ACHSPAT,0),U),ACHSPAT)=$P(^AUTTCOM(ACHSCOMP,0),U)
I '$D(^TMP("ACHSRELG",$J,"CNTY","TRB",ACHSTRB)) S ^TMP("ACHSRELG",$J,"CNTY","TRB",ACHSTRB)=0
S ^TMP("ACHSRELG",$J,"CNTY","TRB",ACHSTRB)=^TMP("ACHSRELG",$J,"CNTY","TRB",ACHSTRB)+1
Q
;
PRINT ;
S ACHST1=$$C^XBFUNC("CHS population Report")
S ACHST2=$$C^XBFUNC("Tribal CHS Delivery Area: "_ACHSTRC)
S ACHST3=$$C^XBFUNC("For Fiscal Year "_ACHSACFY),X3=0
D BRPT^ACHSFU
X:$D(IO("S")) ACHSPPO
I ACHSRTYP="D" D HDR,DET G:$D(DUOUT)!$D(DTOUT) EXT D TOT
S ACHSRTYP="S" D HDR,SUM,TOT
G EXT Q
;
DET ;DETAILED REPORT
S ACHSCST=0
F S ACHSCST=$O(^TMP("ACHSRELG",$J,"CNTY","T",ACHSCST)) Q:ACHSCST'?1N.N D Q:$D(DUOUT)!$D(DTOUT)
.S ACHSCTY=$O(^AUTTCTY("C",ACHSCST,0)) D HDRD
.S ACHSTRB=0 F S ACHSTRB=$O(^TMP("ACHSRELG",$J,"CNTY","T",ACHSCST,ACHSTRB)) Q:ACHSTRB="" D Q:$D(DUOUT)!$D(DTOUT)
..D HDRD1
..S ACHSPAT=0 F S ACHSPAT=$O(^TMP("ACHSRELG",$J,"CNTY","T",ACHSCST,ACHSTRB,ACHSPAT)) Q:ACHSPAT="" D Q:$D(DUOUT)!$D(DTOUT)
...S ACHSIEN=0 F S ACHSIEN=$O(^TMP("ACHSRELG",$J,"CNTY","T",ACHSCST,ACHSTRB,ACHSPAT,ACHSIEN)) Q:ACHSIEN="" D Q:$D(DUOUT)!$D(DTOUT)
....W !?2,ACHSPAT,?50,^TMP("ACHSRELG",$J,"CNTY","T",ACHSCST,ACHSTRB,ACHSPAT,ACHSIEN)
....I $Y>ACHSBM D RTRN^ACHS Q:$D(DUOUT)!$D(DTOUT) D HDR,HDRD,HDRD1
.Q:$D(DUOUT)!$D(DTOUT)
.W !!,"Total County = ",$J($P(^TMP("ACHSRELG",$J,"CNTY",ACHSCST,0),U),10),!,$$REPEAT^XLFSTR("=",79),!
.I $Y>ACHSBM D RTRN^ACHS Q:$D(DUOUT)!$D(DTOUT) D HDR,HDRD,HDRD1
Q
SUM ;SUMMARY REPORT
;
S ACHSCST=0
F S ACHSCST=$O(^TMP("ACHSRELG",$J,"CNTY",ACHSCST)) Q:ACHSCST'?1N.N D
.S ACHSCTY=$O(^AUTTCTY("C",ACHSCST,0))
.W !,$P(^AUTTCTY(ACHSCTY,0),U),?45,$J($P(^TMP("ACHSRELG",$J,"CNTY",ACHSCST,0),U),10)
.I $Y>ACHSBM D RTRN^ACHS Q:$D(DUOUT)!$D(DTOUT) D HDR
W !
S ACHSTRB=0
F S ACHSTRB=$O(^TMP("ACHSRELG",$J,"CNTY","TRB",ACHSTRB)) Q:ACHSTRB'?1N.N D
.W !,$P(^AUTTTRI(ACHSTRB,0),U),?45,"TOTAL = ",$J($P(^TMP("ACHSRELG",$J,"CNTY","TRB",ACHSTRB),U),10)
.I $Y>ACHSBM D RTRN^ACHS Q:$D(DUOUT)!$D(DTOUT) D HDR
Q
;
HDR ; Paginate.
S ACHSPG=ACHSPG+1
W @IOF,!!?19,"*** CONTRACT HEALTH MANAGEMENT SYSTEM ***",!,ACHSUSR,?71,"Page",$J(ACHSPG,3),!,ACHSLOC,!,ACHST1,!,ACHST2,!,ACHSTIME,!,ACHST3
I ACHSRTYP="S" D
.W !,"CHSDA-County",?45,"Population Total"
W !,$$REPEAT^XLFSTR("=",79),!
Q
HDRD ;DETAILED HEADING
W "CHSDA-County: ",$P(^AUTTCTY(ACHSCTY,0),U)
Q
HDRD1 ;
W !!,"Tribe of Enrollment: ",ACHSTRB
W !,"Patient Name",?48,"Community"
Q
TOT ;TOTALS
W !!,"Total CHS Delivery Area = ",$J(^TMP("ACHSRELG",$J,"TOTELG"),10)
D RTRN^ACHS Q:$D(DUOUT)!$D(DTOUT)
Q
ACHSRELG ;IHS/OIT/FCJ - Eligibility population Report by Tribe and FY
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**18**;JUN 11, 2001
+2 ;ACHS*3.1*18 new routine
+3 ;Eligibility population report by TRIBAL CHSDA and FY
ST ;
+1 SET ACHSIO=IO
+2 WRITE !!,"This is a CHS population report based on Tribal CHSDA,"
+3 WRITE !,"community of residence and Fiscal Year."
+4 WRITE !,"The CHS Service Delivery Area is entered by county,"
+5 WRITE !,"then checked against the patient's community of residence."
+6 WRITE !!,"NOTE: If all counties are not listed for selected Tribal CHSDA"
+7 WRITE !,"use the option SDA Enter/Edit Tribal CHSDA to update counties"
+8 ;
FY ; Select FY.
+1 SET ACHSACFY=$$FYSEL^ACHS(1)
+2 IF $DATA(DTOUT)!$DATA(DUOUT)
GOTO EXT
+3 IF '$DATA(^ACHS(9,DUZ(2),"FY",ACHSACFY))
WRITE !!,*7,"Fiscal year '",ACHSACFY,"' does not exist. -- TRY AGAIN"
GOTO FY
FYDT ;BEG AND END DATES FOR THE FY, DOS >ACHSBFY OR <ACHSEFY
+1 IF $PIECE(^ACHSF(DUZ(2),0),U,7)=1
SET ACHSBFY=ACHSACFY-1701_($PIECE(^ACHSF(DUZ(2),0),U,6)-1)
SET ACHSEFY=ACHSACFY-1700_($PIECE(^ACHSF(DUZ(2),0),U,6)-1)
+2 IF '$TEST
SET ACHSBFY=ACHSACFY-1700_($PIECE(^ACHSF(DUZ(2),0),U,6)-1)
SET ACHSEFY=ACHSACFY-1699_($PIECE(^ACHSF(DUZ(2),0),U,6)-1)
+3 ;
TRB ;Tribal CHSDA
+1 ;
+2 WRITE !
+3 SET DIC="^ACHSSDA("
SET DIC(0)="AEQM"
+4 SET DIC("A")="Enter the Tribal CHSDA: "
+5 DO ^DIC
+6 IF +Y<0
GOTO FY
+7 SET ACHSSDA=+Y
+8 ;
TYPE ; TYPE OF REPORT SUMARRY OR DETAILED
+1 ; Enter Summary or Detail
+2 SET DIR(0)="S^S:SUMMARY;D:DETAILED"
SET DIR("A")="Report Type "
SET DIR("B")="SUMMARY"
+3 SET DIR("?")="Detail will display indiviual PO, Summary will display only the totals"
+4 DO ^DIR
+5 IF $DATA(DUOUT)
GOTO EXT
IF $DATA(DTOUT)
GOTO EXT
IF $DATA(DIROUT)
GOTO EXT
+6 SET ACHSRTYP=Y
DEV ; Select device for report.
+1 SET %=$$PB^ACHS
+2 IF %=U!$DATA(DTOUT)!$DATA(DUOUT)
GOTO EXT
+3 IF %="B"
DO VIEWR^XBLM("A1^ACHSRELG")
DO EN^XBVK("VALM")
GOTO EXT
+4 KILL IOP,%ZIS
+5 SET %ZIS="PQ"
+6 DO ^%ZIS
IF $DATA(IO("S"))
DO SLV^ACHSFU
+7 KILL %ZIS
+8 IF POP
WRITE !,*7,"No device specified."
DO HOME^%ZIS
GOTO EXT
+9 IF '$DATA(IO("Q"))
GOTO A1
+10 KILL IO("Q")
+11 IF $EXTRACT(IOST)'="P"
WRITE *7,!,"Please queue to printers only."
GOTO DEV
+12 SET ZTIO=""
SET ACHSQIO=ION_";"_IOST_";"_IOM_";"_IOSL
SET ZTRTN="A1^ACHSRGPR"
SET ZTDESC="CHS GPRA Report, "_ACHSRPT_", "_$$FMTE^XLFDT(ACHSBDT)_" to "_$$FMTE^XLFDT(ACHSEDT)
+13 FOR %="ACHSQIO","ACHSBDT","ACHSEDT","ACHSRTYP","ACHSACFY","ACHSEFY","ACHSBFY","ACHSSDA"
SET ZTSAVE(%)=""
+14 DO ^%ZTLOAD
+15 IF '$DATA(ZTSK)
GOTO DEV
+16 ;
+17 ;end of interactive portion. The rest performed by Taskman
+18 ;
A1 ;EP - TaskMan.
+1 DO FC^ACHSUF
+2 IF $DATA(ACHSERR)
IF ACHSERR=1
GOTO EXT
+3 KILL ^TMP("ACHSRELG",$JOB)
+4 SET ^TMP("ACHSRELG",$JOB,"TOTELG")=0
+5 SET ACHSTRC=$PIECE(^AUTTTRI($PIECE(^ACHSSDA(ACHSSDA,0),U),0),U)
+6 ;
CNTY ;SET COUNTY AND COMMUNITY CODES IN TMP GLB
+1 SET ACHSCNTY=0
+2 FOR
SET ACHSCNTY=$ORDER(^ACHSSDA(ACHSSDA,30,ACHSCNTY))
IF ACHSCNTY'?1N.N
QUIT
Begin DoDot:1
+3 SET ACHSCST=$PIECE(^AUTTCTY($PIECE(^ACHSSDA(ACHSSDA,30,ACHSCNTY,0),U),0),U,4)
+4 SET ^TMP("ACHSRELG",$JOB,"CNTY",ACHSCST,0)=0
+5 SET ACHSCOM=ACHSCST_"000"
SET ACHSCOMT=ACHSCST_999
+6 FOR
SET ACHSCOM=$ORDER(^AUTTCOM("C",ACHSCOM))
IF (ACHSCOM="")!(ACHSCOM>ACHSCOMT)
QUIT
Begin DoDot:2
+7 SET ^TMP("ACHSRELG",$JOB,"CNTY",ACHSCST,ACHSCOM)=0
+8 SET ACHSCOMP=$ORDER(^AUTTCOM("C",ACHSCOM,0))
+9 SET ^TMP("ACHSRELG",$JOB,"COM",ACHSCOMP)=ACHSCOM
End DoDot:2
End DoDot:1
+10 ;
REG ;CHECK PAT FOR CURRENT COM
+1 ;TEST FOR NON-INDIAN BENEFICIARY, NON-INDIAN MEMBER OF IND. HOUSEHOLD AND UNSPECIFIED
+2 SET ACHSTCD1=$ORDER(^AUTTTRI("C","000",0))
SET ACHSTCD2=$ORDER(^AUTTTRI("C",970,0))
SET ACHSTCD3=$ORDER(^AUTTTRI("C",999,0))
+3 SET ACHSPAT=0
SET ACHSCT=0
+4 FOR
SET ACHSPAT=$ORDER(^AUPNPAT(ACHSPAT))
IF ACHSPAT'?1N.N
QUIT
Begin DoDot:1
+5 SET ACHSCT=ACHSCT+1
IF '$DATA(ZTQUEUED)
IF ACHSCT#1000=0
WRITE "."
+6 ;TEST TRIBAL ENROLLMENT
+7 IF '$DATA(^AUPNPAT(ACHSPAT,11))
QUIT
+8 SET ACHSTRB=$PIECE(^AUPNPAT(ACHSPAT,11),U,8)
+9 IF (ACHSTRB=ACHSTCD1)!(ACHSTRB=ACHSTCD2)!(ACHSTRB=ACHSTCD3)!(ACHSTRB="")
QUIT
+10 ;TEST FOR DATE OF DEATH, QUIT IF DATE IS < BEG DATE OF FY
+11 IF $DATA(^DPT(ACHSPAT,.35))
IF $PIECE(^DPT(ACHSPAT,.35),U)<ACHSBFY
QUIT
+12 ;TEST FOR CURRENT COMMUNITY AND DATE MOVE < THE LAST DAY OF THE FY
+13 SET ACHSCOMP=$PIECE(^AUPNPAT(ACHSPAT,11),U,17)
SET ACHSCCDT=$PIECE(^(11),U,13)
+14 IF 'ACHSCOMP
QUIT
+15 IF $DATA(^TMP("ACHSRELG",$JOB,"COM",ACHSCOMP))
IF ACHSCCDT<ACHSEFY
DO SET
QUIT
+16 ;THEN TEST PREVIOUS COMMUNITY FOR DATES WITH IN SELECTED FY
+17 IF $DATA(^AUPNPAT(ACHSPAT,51))
SET ACHSQUIT=0
Begin DoDot:2
+18 SET L=0
FOR
SET L=$ORDER(^AUPNPAT(ACHSPAT,51,L))
IF L'?1N.N
QUIT
Begin DoDot:3
+19 IF L>ACHSEFY
QUIT
+20 SET ACHSCOMP=$PIECE(^AUPNPAT(ACHSPAT,51,L,0),U,3)
+21 IF ACHSCOMP
IF $DATA(^TMP("ACHSRELG",$JOB,"COM",ACHSCOMP))
IF (L>ACHSBFY&L<ACHSEFY)
DO SET
SET ACHSQUIT=1
QUIT
+22 IF ACHSCOMP
IF $DATA(^TMP("ACHSRELG",$JOB,"COM",ACHSCOMP))
IF L<ACHSBFY
Begin DoDot:4
+23 SET L1=L
SET L1=$ORDER(^AUPNPAT(ACHSPAT,51,L1))
IF L1=""
DO SET
SET ACHSQUIT=1
QUIT
+24 IF L1>ACHSBFY
IF L1<ACHSEFY
DO SET
SET ACHSQUIT=1
QUIT
End DoDot:4
End DoDot:3
IF ACHSQUIT=1
QUIT
End DoDot:2
End DoDot:1
+25 DO PRINT
+26 ;
EXT ; Kill vars, close device, quit.
+1 IF $DATA(IO("S"))
XECUTE ACHSPPC
+2 IF '$TEST
DO ^%ZISC
+3 DO EN^XBVK("ACHS")
IF '$DATA(ZTQUEUED)
DO ^ACHSVAR
+4 KILL ^TMP("ACHSRELG",$JOB)
+5 KILL DTOUT,DUOUT,ZTSK
+6 QUIT
+7 ;
SET ;SET THE DATA FOR ELIG PATIENT
+1 ;
+2 SET ACHSCOM=^TMP("ACHSRELG",$JOB,"COM",ACHSCOMP)
SET ACHSCST=$EXTRACT(ACHSCOM,1,4)
+3 SET ^TMP("ACHSRELG",$JOB,"CNTY",ACHSCST,ACHSCOM)=^TMP("ACHSRELG",$JOB,"CNTY",ACHSCST,ACHSCOM)+1
+4 SET ^TMP("ACHSRELG",$JOB,"CNTY",ACHSCST,0)=^TMP("ACHSRELG",$JOB,"CNTY",ACHSCST,0)+1
+5 SET ^TMP("ACHSRELG",$JOB,"TOTELG")=^TMP("ACHSRELG",$JOB,"TOTELG")+1
+6 ;Q:ACHSRTYP="S"
+7 SET ^TMP("ACHSRELG",$JOB,"CNTY","T",ACHSCST,$PIECE(^AUTTTRI(ACHSTRB,0),U),$PIECE(^DPT(ACHSPAT,0),U),ACHSPAT)=$PIECE(^AUTTCOM(ACHSCOMP,0),U)
+8 IF '$DATA(^TMP("ACHSRELG",$JOB,"CNTY","TRB",ACHSTRB))
SET ^TMP("ACHSRELG",$JOB,"CNTY","TRB",ACHSTRB)=0
+9 SET ^TMP("ACHSRELG",$JOB,"CNTY","TRB",ACHSTRB)=^TMP("ACHSRELG",$JOB,"CNTY","TRB",ACHSTRB)+1
+10 QUIT
+11 ;
PRINT ;
+1 SET ACHST1=$$C^XBFUNC("CHS population Report")
+2 SET ACHST2=$$C^XBFUNC("Tribal CHS Delivery Area: "_ACHSTRC)
+3 SET ACHST3=$$C^XBFUNC("For Fiscal Year "_ACHSACFY)
SET X3=0
+4 DO BRPT^ACHSFU
+5 IF $DATA(IO("S"))
XECUTE ACHSPPO
+6 IF ACHSRTYP="D"
DO HDR
DO DET
IF $DATA(DUOUT)!$DATA(DTOUT)
GOTO EXT
DO TOT
+7 SET ACHSRTYP="S"
DO HDR
DO SUM
DO TOT
+8 GOTO EXT
QUIT
+9 ;
DET ;DETAILED REPORT
+1 SET ACHSCST=0
+2 FOR
SET ACHSCST=$ORDER(^TMP("ACHSRELG",$JOB,"CNTY","T",ACHSCST))
IF ACHSCST'?1N.N
QUIT
Begin DoDot:1
+3 SET ACHSCTY=$ORDER(^AUTTCTY("C",ACHSCST,0))
DO HDRD
+4 SET ACHSTRB=0
FOR
SET ACHSTRB=$ORDER(^TMP("ACHSRELG",$JOB,"CNTY","T",ACHSCST,ACHSTRB))
IF ACHSTRB=""
QUIT
Begin DoDot:2
+5 DO HDRD1
+6 SET ACHSPAT=0
FOR
SET ACHSPAT=$ORDER(^TMP("ACHSRELG",$JOB,"CNTY","T",ACHSCST,ACHSTRB,ACHSPAT))
IF ACHSPAT=""
QUIT
Begin DoDot:3
+7 SET ACHSIEN=0
FOR
SET ACHSIEN=$ORDER(^TMP("ACHSRELG",$JOB,"CNTY","T",ACHSCST,ACHSTRB,ACHSPAT,ACHSIEN))
IF ACHSIEN=""
QUIT
Begin DoDot:4
+8 WRITE !?2,ACHSPAT,?50,^TMP("ACHSRELG",$JOB,"CNTY","T",ACHSCST,ACHSTRB,ACHSPAT,ACHSIEN)
+9 IF $Y>ACHSBM
DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
DO HDR
DO HDRD
DO HDRD1
End DoDot:4
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
End DoDot:3
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
End DoDot:2
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+10 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+11 WRITE !!,"Total County = ",$JUSTIFY($PIECE(^TMP("ACHSRELG",$JOB,"CNTY",ACHSCST,0),U),10),!,$$REPEAT^XLFSTR("=",79),!
+12 IF $Y>ACHSBM
DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
DO HDR
DO HDRD
DO HDRD1
End DoDot:1
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+13 QUIT
SUM ;SUMMARY REPORT
+1 ;
+2 SET ACHSCST=0
+3 FOR
SET ACHSCST=$ORDER(^TMP("ACHSRELG",$JOB,"CNTY",ACHSCST))
IF ACHSCST'?1N.N
QUIT
Begin DoDot:1
+4 SET ACHSCTY=$ORDER(^AUTTCTY("C",ACHSCST,0))
+5 WRITE !,$PIECE(^AUTTCTY(ACHSCTY,0),U),?45,$JUSTIFY($PIECE(^TMP("ACHSRELG",$JOB,"CNTY",ACHSCST,0),U),10)
+6 IF $Y>ACHSBM
DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
DO HDR
End DoDot:1
+7 WRITE !
+8 SET ACHSTRB=0
+9 FOR
SET ACHSTRB=$ORDER(^TMP("ACHSRELG",$JOB,"CNTY","TRB",ACHSTRB))
IF ACHSTRB'?1N.N
QUIT
Begin DoDot:1
+10 WRITE !,$PIECE(^AUTTTRI(ACHSTRB,0),U),?45,"TOTAL = ",$JUSTIFY($PIECE(^TMP("ACHSRELG",$JOB,"CNTY","TRB",ACHSTRB),U),10)
+11 IF $Y>ACHSBM
DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
DO HDR
End DoDot:1
+12 QUIT
+13 ;
HDR ; Paginate.
+1 SET ACHSPG=ACHSPG+1
+2 WRITE @IOF,!!?19,"*** CONTRACT HEALTH MANAGEMENT SYSTEM ***",!,ACHSUSR,?71,"Page",$JUSTIFY(ACHSPG,3),!,ACHSLOC,!,ACHST1,!,ACHST2,!,ACHSTIME,!,ACHST3
+3 IF ACHSRTYP="S"
Begin DoDot:1
+4 WRITE !,"CHSDA-County",?45,"Population Total"
End DoDot:1
+5 WRITE !,$$REPEAT^XLFSTR("=",79),!
+6 QUIT
HDRD ;DETAILED HEADING
+1 WRITE "CHSDA-County: ",$PIECE(^AUTTCTY(ACHSCTY,0),U)
+2 QUIT
HDRD1 ;
+1 WRITE !!,"Tribe of Enrollment: ",ACHSTRB
+2 WRITE !,"Patient Name",?48,"Community"
+3 QUIT
TOT ;TOTALS
+1 WRITE !!,"Total CHS Delivery Area = ",$JUSTIFY(^TMP("ACHSRELG",$JOB,"TOTELG"),10)
+2 DO RTRN^ACHS
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+3 QUIT
