- 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
