AGTRBL ; IHS/ASDS/EFG - TRIBAL BLOOD QUANTUM STATISTICS REPORT ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
;
S DIC="^AUTTTRI(",DIC(0)="QAZEM" D ^DIC K DIC Q:+Y<1 S AGTRIBE=+Y,AGIO=IO
DEV S %ZIS="OPQ" D ^%ZIS I POP S IOP=ION D ^%ZIS Q
G:'$D(IO("Q")) START K IO("Q") I $D(IO("S"))!($E(IOST)'="P") W *7,!,"Please queue to system printers." D ^%ZISC G DEV
X ^%ZOSF("UCI") S ZTRTN="START^AGTRBL",ZTUCI=Y,ZTIO="",ZTDESC="Tribe Bld Q rpt for "_$P(^AUTTTRI(AGTRIBE,0),U)_".",AGQIO=IO F G="AGTRIBE","AGQIO" S ZTSAVE(G)=""
D ^%ZTLOAD G:'$D(ZTSK) DEV K AG,AGIO,AGQIO,G,AGTRIBE,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTUCI D ^%ZISC
Q
START ;EP - From TaskMan.
S (DFN,AGTOT)=0 F I=1:1:9 S AG(I)=0
L S DFN=$O(^AUPNPAT(DFN)) G PRINT:+DFN=0,L:'$D(^AUPNPAT(DFN,41,DUZ(2)))!'$D(^AUPNPAT(DFN,11)),L:$P(^AUPNPAT(DFN,41,DUZ(2),0),U,3)]""!'$D(^DPT(DFN,0)),L:+$P(^AUPNPAT(DFN,11),U,8)'=AGTRIBE
S AGTRIBEQ=$P(^AUPNPAT(DFN,11),U,9) G L:AGTRIBEQ=""
S AGT("TR")=1,Y=$S(AGTRIBEQ="FULL":1,AGTRIBEQ="NONE":5,AGTRIBEQ="UNKNOWN":6,AGTRIBEQ="UNSPECIFIED":7,1:0) I Y S AG(Y)=AG(Y)+1 S:Y=5 AGT("TR")=0 G L9
S AGNUM=$P(AGTRIBEQ,"/",1),AGDEN=$P(AGTRIBEQ,"/",2)
G L:+AGDEN=0
S AGTRIBEQ=AGNUM/AGDEN,AG=AGTRIBEQ
I AG'<1 S AG(1)=AG(1)+1 G L9
I AG'<.5 S AG(2)=AG(2)+1 G L9
I AG'<.25 S AG(3)=AG(3)+1 G L9
S AGT("TR")=0
I AG>0 S AG(4)=AG(4)+1 G L9
S AG(5)=AG(5)+1
L9 G L:'$D(^AUPNMCD("B",DFN))!(AGT("TR")=1)
S AG(9)=AG(9)+1
G L
PRINT S AGTRIBE=$P(^AUTTTRI(AGTRIBE,0),U),AG("LOC")=$P(^DIC(4,DUZ(2),0),U),AG("USR")=$P(^VA(200,DUZ,0),U)
F AG=1:1:7 S AGTOT=AGTOT+AG(AG)
I $D(AGQIO) F AGZ("I")=1:1 S IOP=AGQIO D ^%ZIS Q:'POP H 30
U IO D LINES^AG,NOW^AG
W $$S^AGVDF("IOF"),!,AG("*"),!
W !,AG("USR"),?80-$L(AG("LOC"))\2,AG("LOC")
W !!?20,"TRIBAL BLOOD QUANTUM STATISTICAL SUMMARY",!?19,"PERCENTAGE OF REGISTERED TRIBAL POPULATION",!!?80-$L("TRIBE: "_AGTRIBE)\2,"TRIBE: "_AGTRIBE
W !!?80-$L("Report date: "_AGTIME)\2,"Report date: ",AGTIME,!
W !,AG("*"),!
W !,"""POPULATION"" represents those patients who.....",!!?5,"1) are on file in the local computer,",!?5,"2) are registered at the above facility,"
W !?5,"3) have valid data in the tribal quantum field,",!?5,"4) are not designated as inactive patients,",!?5,"5) are members of the ",AGTRIBE," tribe."
W !!!,"TRIBAL QUANTUM.... (POPULATION: ",AGTOT,")" G END:AGTOT<1
W ! F I=1:1:5,7,6 W !?5,$J($P("FULL^LESS THAN FULL^LESS THAN 1/2^LESS THAN 1/4^NONE^UNKNOWN^UNSPECIFIED",U,I),15),":",?25,$J(AG(I)/AGTOT*100,6,1),"%"
D RTRN^AG
MCD W !!!!!,"Total LESS-THAN-1/4 WITH MEDICAID:",?25,$J(AG(9)/AGTOT*100,6,1),"%",?50,"(Number of patients: ",AG(9),")"
W !!," Based on a population of ",AGTOT," and representing those patients having.....",!," 1) ""less than 1/4"" or ""none"" for Tribal quantum, and",!," 2) membership in the ",AGTRIBE," tribe."
END D RTRN^AG W $$S^AGVDF("IOF") D ^%ZISC
K AG,AGIO,AGT,AGTIME,AGQIO,DA,AGDEN,DFN,DIC,DR,I,AG("LOC"),AGNUM,AGTOT,AGTRIBE,AGTRIBEQ,AGTXT,AG("USR"),X,Y
D:$D(ZTQUEUED) KILL^%ZTLOAD
Q
AGTRBL ; IHS/ASDS/EFG - TRIBAL BLOOD QUANTUM STATISTICS REPORT ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 ;
+3 SET DIC="^AUTTTRI("
SET DIC(0)="QAZEM"
DO ^DIC
KILL DIC
IF +Y<1
QUIT
SET AGTRIBE=+Y
SET AGIO=IO
DEV SET %ZIS="OPQ"
DO ^%ZIS
IF POP
SET IOP=ION
DO ^%ZIS
QUIT
+1 IF '$DATA(IO("Q"))
GOTO START
KILL IO("Q")
IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
WRITE *7,!,"Please queue to system printers."
DO ^%ZISC
GOTO DEV
+2 XECUTE ^%ZOSF("UCI")
SET ZTRTN="START^AGTRBL"
SET ZTUCI=Y
SET ZTIO=""
SET ZTDESC="Tribe Bld Q rpt for "_$PIECE(^AUTTTRI(AGTRIBE,0),U)_"."
SET AGQIO=IO
FOR G="AGTRIBE","AGQIO"
SET ZTSAVE(G)=""
+3 DO ^%ZTLOAD
IF '$DATA(ZTSK)
GOTO DEV
KILL AG,AGIO,AGQIO,G,AGTRIBE,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTUCI
DO ^%ZISC
+4 QUIT
START ;EP - From TaskMan.
+1 SET (DFN,AGTOT)=0
FOR I=1:1:9
SET AG(I)=0
L SET DFN=$ORDER(^AUPNPAT(DFN))
IF +DFN=0
GOTO PRINT
IF '$DATA(^AUPNPAT(DFN,41,DUZ(2)))!'$DATA(^AUPNPAT(DFN,11))
GOTO L
IF $PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,3)]""!'$DATA(^DPT(DFN,0))
GOTO L
IF +$PIECE(^AUPNPAT(DFN,11),U,8)'=AGTRIBE
GOTO L
+1 SET AGTRIBEQ=$PIECE(^AUPNPAT(DFN,11),U,9)
IF AGTRIBEQ=""
GOTO L
+2 SET AGT("TR")=1
SET Y=$SELECT(AGTRIBEQ="FULL":1,AGTRIBEQ="NONE":5,AGTRIBEQ="UNKNOWN":6,AGTRIBEQ="UNSPECIFIED":7,1:0)
IF Y
SET AG(Y)=AG(Y)+1
IF Y=5
SET AGT("TR")=0
GOTO L9
+3 SET AGNUM=$PIECE(AGTRIBEQ,"/",1)
SET AGDEN=$PIECE(AGTRIBEQ,"/",2)
+4 IF +AGDEN=0
GOTO L
+5 SET AGTRIBEQ=AGNUM/AGDEN
SET AG=AGTRIBEQ
+6 IF AG'<1
SET AG(1)=AG(1)+1
GOTO L9
+7 IF AG'<.5
SET AG(2)=AG(2)+1
GOTO L9
+8 IF AG'<.25
SET AG(3)=AG(3)+1
GOTO L9
+9 SET AGT("TR")=0
+10 IF AG>0
SET AG(4)=AG(4)+1
GOTO L9
+11 SET AG(5)=AG(5)+1
L9 IF '$DATA(^AUPNMCD("B",DFN))!(AGT("TR")=1)
GOTO L
+1 SET AG(9)=AG(9)+1
+2 GOTO L
PRINT SET AGTRIBE=$PIECE(^AUTTTRI(AGTRIBE,0),U)
SET AG("LOC")=$PIECE(^DIC(4,DUZ(2),0),U)
SET AG("USR")=$PIECE(^VA(200,DUZ,0),U)
+1 FOR AG=1:1:7
SET AGTOT=AGTOT+AG(AG)
+2 IF $DATA(AGQIO)
FOR AGZ("I")=1:1
SET IOP=AGQIO
DO ^%ZIS
IF 'POP
QUIT
HANG 30
+3 USE IO
DO LINES^AG
DO NOW^AG
+4 WRITE $$S^AGVDF("IOF"),!,AG("*"),!
+5 WRITE !,AG("USR"),?80-$LENGTH(AG("LOC"))\2,AG("LOC")
+6 WRITE !!?20,"TRIBAL BLOOD QUANTUM STATISTICAL SUMMARY",!?19,"PERCENTAGE OF REGISTERED TRIBAL POPULATION",!!?80-$LENGTH("TRIBE: "_AGTRIBE)\2,"TRIBE: "_AGTRIBE
+7 WRITE !!?80-$LENGTH("Report date: "_AGTIME)\2,"Report date: ",AGTIME,!
+8 WRITE !,AG("*"),!
+9 WRITE !,"""POPULATION"" represents those patients who.....",!!?5,"1) are on file in the local computer,",!?5,"2) are registered at the above facility,"
+10 WRITE !?5,"3) have valid data in the tribal quantum field,",!?5,"4) are not designated as inactive patients,",!?5,"5) are members of the ",AGTRIBE," tribe."
+11 WRITE !!!,"TRIBAL QUANTUM.... (POPULATION: ",AGTOT,")"
IF AGTOT<1
GOTO END
+12 WRITE !
FOR I=1:1:5,7,6
WRITE !?5,$JUSTIFY($PIECE("FULL^LESS THAN FULL^LESS THAN 1/2^LESS THAN 1/4^NONE^UNKNOWN^UNSPECIFIED",U,I),15),":",?25,$JUSTIFY(AG(I)/AGTOT*100,6,1),"%"
+13 DO RTRN^AG
MCD WRITE !!!!!,"Total LESS-THAN-1/4 WITH MEDICAID:",?25,$JUSTIFY(AG(9)/AGTOT*100,6,1),"%",?50,"(Number of patients: ",AG(9),")"
+1 WRITE !!," Based on a population of ",AGTOT," and representing those patients having.....",!," 1) ""less than 1/4"" or ""none"" for Tribal quantum, and",!," 2) membership in the ",AGTRIBE," tribe."
END DO RTRN^AG
WRITE $$S^AGVDF("IOF")
DO ^%ZISC
+1 KILL AG,AGIO,AGT,AGTIME,AGQIO,DA,AGDEN,DFN,DIC,DR,I,AG("LOC"),AGNUM,AGTOT,AGTRIBE,AGTRIBEQ,AGTXT,AG("USR"),X,Y
+2 IF $DATA(ZTQUEUED)
DO KILL^%ZTLOAD
+3 QUIT
