AGBLDS ; IHS/ASDS/EFG - BLOOD QUANTUM: % OF REGISTERED POPULATION ;
;;7.1;PATIENT REGISTRATION;;AUG 25,2005
S 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^AGBLDS",ZTUCI=Y,ZTIO="",ZTDESC="BLOOD QUANTUM STATISTICAL SUMMARY.",AGQIO=IO F G="AGQIO" S ZTSAVE(G)=""
D ^%ZTLOAD G:'$D(ZTSK) DEV K AG,AGIO,AGQIO,G,ZTDESC,ZTIO,ZTRTN,ZTSK,ZTUCI D ^%ZISC
Q
START ;EP - From TaskMan.
S (DFN,AGTOT,AGTTOT,AGGTOT)=0 F AG=1:1:8 S (AG(AG),AGT(AG))=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)) S (AGT("TR"),AGT("IN"))=1
S AGTQ=$P(^AUPNPAT(DFN,11),U,9),AGIQ=$P(^(11),U,10) I AGTQ="" S AGTQ="INV" G L5
S Y=$S(AGTQ="FULL":1,AGTQ="NONE":5,AGTQ="UNKNOWN":6,AGTQ="UNSPECIFIED":7,1:0) I Y S AG(Y)=AG(Y)+1 S:Y=5 AGT("TR")=0 G L5
S AGNUM=$P(AGTQ,"/",1),AGDEN=$P(AGTQ,"/",2) I +AGDEN=0 S AGTQ="INV" G L5
S AGTQ=AGNUM/AGDEN,AG=AGTQ
I AG'<1 S AG(1)=AG(1)+1 G L5
I AG'<.5 S AG(2)=AG(2)+1 G L5
I AG'<.25 S AG(3)=AG(3)+1 G L5
S AGT("TR")=0
I AG>0 S AG(4)=AG(4)+1 G L5
S AG(5)=AG(5)+1
L5 I AGIQ="" S AGIQ="INV" G L9
S Y=$S(AGIQ="FULL":1,AGIQ="NONE":5,AGIQ="UNKNOWN":6,AGIQ="UNSPECIFIED":7,1:0) I Y S AGT(Y)=AGT(Y)+1 S:Y=5 AGT("IN")=0 G L9
S AGNUM=$P(AGIQ,"/",1),AGDEN=$P(AGIQ,"/",2) I +AGDEN=0 S AGIQ="INV" G L9
S AGIQ=AGNUM/AGDEN,AG=AGIQ
I AG'<1 S AGT(1)=AGT(1)+1 G L9
I AG'<.5 S AGT(2)=AGT(2)+1 G L9
S AGT("IN")=0
I AG'<.25 S AGT(3)=AGT(3)+1 G L9
I AG>0 S AGT(4)=AGT(4)+1 G L9
S AGT(5)=AGT(5)+1
L9 I AGTQ_AGIQ'["INV" S AGGTOT=AGGTOT+1 S:AGT("TR")+AGT("IN")=0 AG(8)=AG(8)+1
G L
PRINT S AG("LOC")=$P(^DIC(4,DUZ(2),0),U),AG("USR")=$P(^VA(200,DUZ,0),U) F AG=1:1:7 S AGTOT=AG(AG)+AGTOT,AGTTOT=AGT(AG)+AGTTOT
S AGTXT="FULL^LESS THAN FULL^LESS THAN 1/2^LESS THAN 1/4^NONE^UNKNOWN^UNSPECIFIED"
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("*"),!!,AG("USR"),?80-$L(AG("LOC"))\2,AG("LOC"),!!?24,"BLOOD QUANTUM STATISTICAL SUMMARY",!?23,"PERCENTAGE OF REGISTERED POPULATION",!!?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,",!?5,"3) have valid data in the respective quantum fields,"
W !?5,"3) are not designated as inactive patients",!!!,"TRIBAL QUANTUM.... (POPULATION: ",AGTOT,")" G FULL:AGTOT<1
W ! F I=1:1:5,7,6 W !?5,$J($P(AGTXT,U,I),15),":",?25,$J(AG(I)/AGTOT*100,6,1),"%"
D RTRN^AG
FULL W !!!!!,"INDIAN QUANTUM.... (POPULATION: ",AGTTOT,")" G END:AGTTOT<1
W ! F I=1:1:5,7,6 W !?5,$J($P(AGTXT,U,I),15),":",?25,$S(AGTTOT>0:$J(AGT(I)/AGTTOT*100,6,1),1:0),"%"
W !!!!!,"Total ""UNQUALIFIED"":",?25,$S(AGGTOT>0:$J(AG(8)/AGGTOT*100,6,1),1:0),"%",?40,"(Number of patients: ",AG(8),")"
W !!," Based on a population of ",AGGTOT," and representing those patients having.....",!," 1) ""less than 1/4"" or ""none"" for Tribal quant., and",!," 2) ""less than 1/2"" or ""less than 1/4"" or ""none"" for Indian quant."
W !," 3) and, valid data in both quantum fields."
END D RTRN^AG W $$S^AGVDF("IOF") D ^%ZISC
K AG,AGIO,AGQIO,AGIQ,AGT,AGTQ,AGTIME,AGDEN,DFN,DLOUT,AGTOT,I,AG("LOC"),AGNUM,AGGTOT,AGTTOT,AGTXT,AG("USR"),ZTUCI D:$D(ZTQUEUED) KILL^%ZTLOAD
Q
AGBLDS ; IHS/ASDS/EFG - BLOOD QUANTUM: % OF REGISTERED POPULATION ;
+1 ;;7.1;PATIENT REGISTRATION;;AUG 25,2005
+2 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^AGBLDS"
SET ZTUCI=Y
SET ZTIO=""
SET ZTDESC="BLOOD QUANTUM STATISTICAL SUMMARY."
SET AGQIO=IO
FOR G="AGQIO"
SET ZTSAVE(G)=""
+3 DO ^%ZTLOAD
IF '$DATA(ZTSK)
GOTO DEV
KILL AG,AGIO,AGQIO,G,ZTDESC,ZTIO,ZTRTN,ZTSK,ZTUCI
DO ^%ZISC
+4 QUIT
START ;EP - From TaskMan.
+1 SET (DFN,AGTOT,AGTTOT,AGGTOT)=0
FOR AG=1:1:8
SET (AG(AG),AGT(AG))=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
SET (AGT("TR"),AGT("IN"))=1
+1 SET AGTQ=$PIECE(^AUPNPAT(DFN,11),U,9)
SET AGIQ=$PIECE(^(11),U,10)
IF AGTQ=""
SET AGTQ="INV"
GOTO L5
+2 SET Y=$SELECT(AGTQ="FULL":1,AGTQ="NONE":5,AGTQ="UNKNOWN":6,AGTQ="UNSPECIFIED":7,1:0)
IF Y
SET AG(Y)=AG(Y)+1
IF Y=5
SET AGT("TR")=0
GOTO L5
+3 SET AGNUM=$PIECE(AGTQ,"/",1)
SET AGDEN=$PIECE(AGTQ,"/",2)
IF +AGDEN=0
SET AGTQ="INV"
GOTO L5
+4 SET AGTQ=AGNUM/AGDEN
SET AG=AGTQ
+5 IF AG'<1
SET AG(1)=AG(1)+1
GOTO L5
+6 IF AG'<.5
SET AG(2)=AG(2)+1
GOTO L5
+7 IF AG'<.25
SET AG(3)=AG(3)+1
GOTO L5
+8 SET AGT("TR")=0
+9 IF AG>0
SET AG(4)=AG(4)+1
GOTO L5
+10 SET AG(5)=AG(5)+1
L5 IF AGIQ=""
SET AGIQ="INV"
GOTO L9
+1 SET Y=$SELECT(AGIQ="FULL":1,AGIQ="NONE":5,AGIQ="UNKNOWN":6,AGIQ="UNSPECIFIED":7,1:0)
IF Y
SET AGT(Y)=AGT(Y)+1
IF Y=5
SET AGT("IN")=0
GOTO L9
+2 SET AGNUM=$PIECE(AGIQ,"/",1)
SET AGDEN=$PIECE(AGIQ,"/",2)
IF +AGDEN=0
SET AGIQ="INV"
GOTO L9
+3 SET AGIQ=AGNUM/AGDEN
SET AG=AGIQ
+4 IF AG'<1
SET AGT(1)=AGT(1)+1
GOTO L9
+5 IF AG'<.5
SET AGT(2)=AGT(2)+1
GOTO L9
+6 SET AGT("IN")=0
+7 IF AG'<.25
SET AGT(3)=AGT(3)+1
GOTO L9
+8 IF AG>0
SET AGT(4)=AGT(4)+1
GOTO L9
+9 SET AGT(5)=AGT(5)+1
L9 IF AGTQ_AGIQ'["INV"
SET AGGTOT=AGGTOT+1
IF AGT("TR")+AGT("IN")=0
SET AG(8)=AG(8)+1
+1 GOTO L
PRINT SET AG("LOC")=$PIECE(^DIC(4,DUZ(2),0),U)
SET AG("USR")=$PIECE(^VA(200,DUZ,0),U)
FOR AG=1:1:7
SET AGTOT=AG(AG)+AGTOT
SET AGTTOT=AGT(AG)+AGTTOT
+1 SET AGTXT="FULL^LESS THAN FULL^LESS THAN 1/2^LESS THAN 1/4^NONE^UNKNOWN^UNSPECIFIED"
+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("*"),!!,AG("USR"),?80-$LENGTH(AG("LOC"))\2,AG("LOC"),!!?24,"BLOOD QUANTUM STATISTICAL SUMMARY",!?23,"PERCENTAGE OF REGISTERED POPULATION",!!?80-$LENGTH("Report date: "_AGTIME)\2,"Report date: ",AGTIME,!
+5 WRITE !,AG("*"),!
+6 WRITE !,"""POPULATION"" represents those patients who.....",!!?5,"1) are on file in the local computer,",!?5,"2) are registered at the above facility,",!?5,"3) have valid data in the respective quantum fields,"
+7 WRITE !?5,"3) are not designated as inactive patients",!!!,"TRIBAL QUANTUM.... (POPULATION: ",AGTOT,")"
IF AGTOT<1
GOTO FULL
+8 WRITE !
FOR I=1:1:5,7,6
WRITE !?5,$JUSTIFY($PIECE(AGTXT,U,I),15),":",?25,$JUSTIFY(AG(I)/AGTOT*100,6,1),"%"
+9 DO RTRN^AG
FULL WRITE !!!!!,"INDIAN QUANTUM.... (POPULATION: ",AGTTOT,")"
IF AGTTOT<1
GOTO END
+1 WRITE !
FOR I=1:1:5,7,6
WRITE !?5,$JUSTIFY($PIECE(AGTXT,U,I),15),":",?25,$SELECT(AGTTOT>0:$JUSTIFY(AGT(I)/AGTTOT*100,6,1),1:0),"%"
+2 WRITE !!!!!,"Total ""UNQUALIFIED"":",?25,$SELECT(AGGTOT>0:$JUSTIFY(AG(8)/AGGTOT*100,6,1),1:0),"%",?40,"(Number of patients: ",AG(8),")"
+3 WRITE !!," Based on a population of ",AGGTOT," and representing those patients having.....",!," 1) ""less than 1/4"" or ""none"" for Tribal quant., and",!," 2) ""less than 1/2"" or ""less than 1/4"" or ""none"" for Indian quant."
+4 WRITE !," 3) and, valid data in both quantum fields."
END DO RTRN^AG
WRITE $$S^AGVDF("IOF")
DO ^%ZISC
+1 KILL AG,AGIO,AGQIO,AGIQ,AGT,AGTQ,AGTIME,AGDEN,DFN,DLOUT,AGTOT,I,AG("LOC"),AGNUM,AGGTOT,AGTTOT,AGTXT,AG("USR"),ZTUCI
IF $DATA(ZTQUEUED)
DO KILL^%ZTLOAD
+2 QUIT
