- 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
