AGAGEB ; IHS/ASDS/EFG - BLOOD QUANT BY INSURANCE, AGE GROUPS, & FEMALE ;
;;7.1;PATIENT REGISTRATION;**4**;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^AGAGEB",ZTUCI=Y,ZTIO="",ZTDESC="Bld Q Stat Summary by category.",AGQIO=IO F G="AGQIO" S ZTSAVE(G)=""
D ^%ZTLOAD G:'$D(ZTSK) DEV K AGIO,AGQIO,G,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTUCI D ^%ZISC
Q
START ;EP - From TaskMan.
F AG=1:1:10 S (AGLESS(AG),AGMORE(AG))=0
S DFN=0,DIC="^AUTTBEN(",DIC(0)="M",X="NON-INDIAN SPOUSE" D ^DIC S AG("NONINDIAN")=$S(+Y>0:+Y,1:-1)
C S DFN=$O(^DPT(DFN)) G PRINT:+DFN=0,C:'$D(^AUPNPAT(DFN,41,DUZ(2))),C:$P(^AUPNPAT(DFN,41,DUZ(2),0),U,3)]""
S DIC=2,DR=.033,DA=DFN D ^AGDICLK G C:'$D(AG("LKPRINT")) S AGE=AG("LKPRINT")
G C:'$D(^AUPNPAT(DFN,11)) S AG=$P(^(11),U,10) I AG["/"&(+$P(AG,"/",2)=0) S AG=0 G TOTALS
S DIC=9000001,DR=1110.9,DA=DFN D ^AGDICLK G C:'$D(AG("LKPRINT")) S AG=AG("LKPRINT")
TOTALS S AG("A")=$S(AGE<6:1,AGE<12:2,AGE<16:3,AGE<19:4,AGE<65:6,1:7)
I AG<.25 S AGLESS(AG("A"))=AGLESS(AG("A"))+1 G FEMALE
S AGMORE(AG("A"))=AGMORE(AG("A"))+1
FEMALE I $D(^DPT(DFN,0)),$P(^(0),U,2)="F" S:AG<.25 AGLESS(5)=AGLESS(5)+1 S:AG'<.25 AGMORE(5)=AGMORE(5)+1
I $D(^AUPNMCR(DFN,0))!$D(^AUPNRRE(DFN,0)) S:AG<.25 AGLESS(8)=AGLESS(8)+1 S:AG'<.25 AGMORE(8)=AGMORE(8)+1
I $D(^AUPNMCD("B",DFN)) S:AG<.25 AGLESS(9)=AGLESS(9)+1 S:AG'<.25 AGMORE(9)=AGMORE(9)+1
I $P(^AUPNPAT(DFN,11),U,11)=AG("NONINDIAN") S:AG<.25 AGLESS(10)=AGLESS(10)+1 S:AG'<.25 AGMORE(10)=AGMORE(10)+1
G C
PRINT D LINES^AG,NOW^AG S AG("LOC")=$P(^DIC(4,DUZ(2),0),U)
I $D(AGQIO) F AGZ("I")=1:1 S IOP=AGQIO D ^%ZIS Q:'POP H 30
S AGTXT="Less than 6 years old^6 - 11 years old^12 - 15 years old^16 - 18 years old^Females 18 - 35 years old^19 - 64 years old^More than 64 years old^Patients with Medicare or Railroad Ret.^Patients with Medicaid^NON-INDIAN SPOUSE"
U IO W $$S^AGVDF("IOF"),AG("*"),!,$P(^VA(200,DUZ,0),U),?80-$L(AG("LOC"))\2,AG("LOC"),!!?24,"BLOOD QUANTUM STATISTICAL SUMMARY",!?25,"INDIAN BLOOD QUANTUM BY CATEGORY"
;W !!?80-$L("Report date: "_AGTIME)\2,"Report date: ",AGTIME,!!?40,"INDIAN QUANTUM",?64,"INDIAN QUANTUM",!,"CATEGORY NAME",?40,"1/4 OR AGMORE",?64,"AGLESS THAN 1/4",!,AG("="),!
W !!?80-$L("Report date: "_AGTIME)\2,"Report date: ",AGTIME,!!?40,"INDIAN QUANTUM",?64,"INDIAN QUANTUM",!,"CATEGORY NAME",?40,"1/4 OR MORE",?64,"LESS THAN 1/4",!,AG("="),! ;AG*7.1*4
F AG=1:1:4,6,7 W $P(AGTXT,U,AG),?45,$J(AGMORE(AG),5),?70,$J(AGLESS(AG),5),!
S (AG("TM"),AG("TL"))=0 F AG=1:1:4,6,7 S AG("TM")=AG("TM")+AGMORE(AG),AG("TL")=AG("TL")+AGLESS(AG)
W !?40,"_____________",?65,"_____________",!?45,$J(AG("TM"),5),?70,$J(AG("TL"),5),!!!
F AG=5,8,9,10 W $P(AGTXT,U,AG),?45,$J(AGMORE(AG),5),?70,$J(AGLESS(AG),5),!
W !!,"TOTAL REGISTERED POPULATION: ",AG("TM")+AG("TL")
END D RTRN^AG W $$S^AGVDF("IOF") D ^%ZISC
K AG,AGE,AGIO,AGQIO,AGTIME,DA,DFN,DFOUT,DIC,DLOUT,DR,DTOUT,DUOUT,G,AGLESS,AG("LKPRINT"),AG("LOC"),AGMORE,AGTXT,X,Y D:$D(ZTQUEUED) KILL^%ZTLOAD
Q
AGAGEB ; IHS/ASDS/EFG - BLOOD QUANT BY INSURANCE, AGE GROUPS, & FEMALE ;
+1 ;;7.1;PATIENT REGISTRATION;**4**;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")
+2 IF $DATA(IO("S"))!($EXTRACT(IOST)'="P")
WRITE *7,!,"Please queue to system printers."
DO ^%ZISC
GOTO DEV
+3 XECUTE ^%ZOSF("UCI")
SET ZTRTN="START^AGAGEB"
SET ZTUCI=Y
SET ZTIO=""
SET ZTDESC="Bld Q Stat Summary by category."
SET AGQIO=IO
FOR G="AGQIO"
SET ZTSAVE(G)=""
+4 DO ^%ZTLOAD
IF '$DATA(ZTSK)
GOTO DEV
KILL AGIO,AGQIO,G,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZTUCI
DO ^%ZISC
+5 QUIT
START ;EP - From TaskMan.
+1 FOR AG=1:1:10
SET (AGLESS(AG),AGMORE(AG))=0
+2 SET DFN=0
SET DIC="^AUTTBEN("
SET DIC(0)="M"
SET X="NON-INDIAN SPOUSE"
DO ^DIC
SET AG("NONINDIAN")=$SELECT(+Y>0:+Y,1:-1)
C SET DFN=$ORDER(^DPT(DFN))
IF +DFN=0
GOTO PRINT
IF '$DATA(^AUPNPAT(DFN,41,DUZ(2)))
GOTO C
IF $PIECE(^AUPNPAT(DFN,41,DUZ(2),0),U,3)]""
GOTO C
+1 SET DIC=2
SET DR=.033
SET DA=DFN
DO ^AGDICLK
IF '$DATA(AG("LKPRINT"))
GOTO C
SET AGE=AG("LKPRINT")
+2 IF '$DATA(^AUPNPAT(DFN,11))
GOTO C
SET AG=$PIECE(^(11),U,10)
IF AG["/"&(+$PIECE(AG,"/",2)=0)
SET AG=0
GOTO TOTALS
+3 SET DIC=9000001
SET DR=1110.9
SET DA=DFN
DO ^AGDICLK
IF '$DATA(AG("LKPRINT"))
GOTO C
SET AG=AG("LKPRINT")
TOTALS SET AG("A")=$SELECT(AGE<6:1,AGE<12:2,AGE<16:3,AGE<19:4,AGE<65:6,1:7)
+1 IF AG<.25
SET AGLESS(AG("A"))=AGLESS(AG("A"))+1
GOTO FEMALE
+2 SET AGMORE(AG("A"))=AGMORE(AG("A"))+1
FEMALE IF $DATA(^DPT(DFN,0))
IF $PIECE(^(0),U,2)="F"
IF AG<.25
SET AGLESS(5)=AGLESS(5)+1
IF AG'<.25
SET AGMORE(5)=AGMORE(5)+1
+1 IF $DATA(^AUPNMCR(DFN,0))!$DATA(^AUPNRRE(DFN,0))
IF AG<.25
SET AGLESS(8)=AGLESS(8)+1
IF AG'<.25
SET AGMORE(8)=AGMORE(8)+1
+2 IF $DATA(^AUPNMCD("B",DFN))
IF AG<.25
SET AGLESS(9)=AGLESS(9)+1
IF AG'<.25
SET AGMORE(9)=AGMORE(9)+1
+3 IF $PIECE(^AUPNPAT(DFN,11),U,11)=AG("NONINDIAN")
IF AG<.25
SET AGLESS(10)=AGLESS(10)+1
IF AG'<.25
SET AGMORE(10)=AGMORE(10)+1
+4 GOTO C
PRINT DO LINES^AG
DO NOW^AG
SET AG("LOC")=$PIECE(^DIC(4,DUZ(2),0),U)
+1 IF $DATA(AGQIO)
FOR AGZ("I")=1:1
SET IOP=AGQIO
DO ^%ZIS
IF 'POP
QUIT
HANG 30
+2 SET AGTXT="Less than 6 years old^6 - 11 years old^12 - 15 years old^16 - 18 years old^Females 18 - 35 years old^19 - 64 years old^More than 64 years old^Patients with Medicare or Railroad Ret.^Patients with Medicaid^NON-INDIAN SPOUSE"
+3 USE IO
WRITE $$S^AGVDF("IOF"),AG("*"),!,$PIECE(^VA(200,DUZ,0),U),?80-$LENGTH(AG("LOC"))\2,AG("LOC"),!!?24,"BLOOD QUANTUM STATISTICAL SUMMARY",!?25,"INDIAN BLOOD QUANTUM BY CATEGORY"
+4 ;W !!?80-$L("Report date: "_AGTIME)\2,"Report date: ",AGTIME,!!?40,"INDIAN QUANTUM",?64,"INDIAN QUANTUM",!,"CATEGORY NAME",?40,"1/4 OR AGMORE",?64,"AGLESS THAN 1/4",!,AG("="),!
+5 ;AG*7.1*4
WRITE !!?80-$LENGTH("Report date: "_AGTIME)\2,"Report date: ",AGTIME,!!?40,"INDIAN QUANTUM",?64,"INDIAN QUANTUM",!,"CATEGORY NAME",?40,"1/4 OR MORE",?64,"LESS THAN 1/4",!,AG("="),!
+6 FOR AG=1:1:4,6,7
WRITE $PIECE(AGTXT,U,AG),?45,$JUSTIFY(AGMORE(AG),5),?70,$JUSTIFY(AGLESS(AG),5),!
+7 SET (AG("TM"),AG("TL"))=0
FOR AG=1:1:4,6,7
SET AG("TM")=AG("TM")+AGMORE(AG)
SET AG("TL")=AG("TL")+AGLESS(AG)
+8 WRITE !?40,"_____________",?65,"_____________",!?45,$JUSTIFY(AG("TM"),5),?70,$JUSTIFY(AG("TL"),5),!!!
+9 FOR AG=5,8,9,10
WRITE $PIECE(AGTXT,U,AG),?45,$JUSTIFY(AGMORE(AG),5),?70,$JUSTIFY(AGLESS(AG),5),!
+10 WRITE !!,"TOTAL REGISTERED POPULATION: ",AG("TM")+AG("TL")
END DO RTRN^AG
WRITE $$S^AGVDF("IOF")
DO ^%ZISC
+1 KILL AG,AGE,AGIO,AGQIO,AGTIME,DA,DFN,DFOUT,DIC,DLOUT,DR,DTOUT,DUOUT,G,AGLESS,AG("LKPRINT"),AG("LOC"),AGMORE,AGTXT,X,Y
IF $DATA(ZTQUEUED)
DO KILL^%ZTLOAD
+2 QUIT
