- 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
