APCLPCT1 ; IHS/CMI/LAB - CONT OF APCLPCT 7/13/89 1:06 PM ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;PRINT INDIAN PATIENT COUNTS FOR SERVICE UNIT
START ;
S APCL80D="--------------------------------------------------------------------------------" ;80 DASHES
S:APCLFS="S" (APCLSUP,APCLSUN)=$P(^AUTTSU(APCLSU,0),U)
I APCLFS="F" S APCLSUP=$P(^DIC(4,APCLSU,0),U),APCLSUN=$P(^AUTTSU(APCLSUF,0),U)
S (APCL1,APCL2,APCL3,APCL4,APCL5,APCLPG)=0 D HEAD
S APCLMAJ=0 K APCLQUIT
F I=0:0 S APCLMAJ=$O(^XTMP("APCLPCT",APCLJOB,APCLBT,APCLMAJ)) Q:APCLMAJ=""!($D(APCLQUIT)) D MINOR
G:$D(APCLQUIT) DONE
I $Y>(IOSL-8) D HEAD G:$D(APCLQUIT) DONE
W !!?33,"------",?46,"------",?56,"------",?65,"------",?73,"------",!
W ?21,"Total:",?33,$J(APCL1,6),?46,$J(APCL2,6),?56,$J(APCL3,6),?65,$J(APCL4,6),?73,$J(APCL5,6),!
DONE ;
D DONE^APCLOSUT
K ^XTMP("APCLPCT",APCLJOB,APCLBT),^XTMP("APCLPCTR",APCLJOB,APCLBT)
Q
MINOR ;
I $Y>(IOSL-$S(APCLSUB=1:9,1:6)) D HEAD Q:$D(APCLQUIT)
W !,$E(APCLMAJ,1,28) W:APCLSUB=1 !
S APCLMIN=0 F S APCLMIN=$O(^XTMP("APCLPCT",APCLJOB,APCLBT,APCLMAJ,APCLMIN)) Q:APCLMIN=""!($D(APCLQUIT)) D MINOR1
Q:$D(APCLQUIT)
D MAJTOT
Q
MINOR1 ;
S:'$D(^XTMP("APCLPCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ)) ^XTMP("APCLPCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ)="0^0^0^0^0"
F APCLI=1:1:5 S $P(^XTMP("APCLPCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ),U,APCLI)=$P(^XTMP("APCLPCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ),U,APCLI)+$P(^XTMP("APCLPCT",APCLJOB,APCLBT,APCLMAJ,APCLMIN),U,APCLI)
S APCLP=1 F APCLI=1:1:5 S APCLVAR="APCLT"_APCLI,@APCLVAR=$P(^XTMP("APCLPCT",APCLJOB,APCLBT,APCLMAJ,APCLMIN),U,APCLP) S:@APCLVAR="" @APCLVAR=0 S APCLP=APCLP+1
F APCLI=1:1:5 S APCLVAR1="APCL"_APCLI,APCLVAR2="APCLT"_APCLI S @APCLVAR1=@APCLVAR1+@APCLVAR2
Q:APCLSUB'=1
I $Y>(IOSL-7) D HEAD Q:$D(APCLQUIT)
W !?3,$E(APCLMIN,1,25) F APCLI=1:1:5 S APCLVAR="APCLT"_APCLI S APCLT=$P("33,46,57,65,73",",",APCLI) W ?APCLT,$J((@APCLVAR),6)
Q
MAJTOT ;print major sort totals
;I $Y>(IOSL-7) D HEAD Q:$D(APCLQUIT)
G:APCLSUB'=1 MAJTOT1
W !!?33,"------",?46,"------",?56,"------",?65,"------",?73,"------",!
W ?19,"Subtotal:"
MAJTOT1 S APCLP=1 F APCLI=33,46,57,65,73 W ?APCLI,$J($P(^XTMP("APCLPCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ),U,APCLP),6) S APCLP=APCLP+1
W !
Q
HEAD I 'APCLPG G HEAD1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF S APCLPG=APCLPG+1
W $P(^DIC(4,DUZ(2),0),U),?60,APCLDTP,?72,"Page ",APCLPG,!
W !,"Registration and Visit Counts for ",$S(APCLIND=1:"Indian",1:"all")," Patients registered ",$S(APCLFS="F":"at ",1:"in ")
W !,APCLSUP," ",$S(APCLFS="F":"Facility",1:"Service Unit"),".",!
W "The report is sorted by ",$S(APCLSORT="C":"Community of Residence",APCLSORT="T":"Tribe of Membership",1:"Service Unit of Residence"),$S(APCLSUB=1:" and by ",1:".")
W:APCLSUB=1 $S(APCLSORT="C":"Tribe of Membership.",1:"Community of Residence.")
W !,"A '*' after the Community name indicates a Non-Service Unit Community.",!
W "Visit Counts between ",APCLSDY," and ",APCLEDY,".",!
W !,$S(APCLSORT="C":"Current Community of",APCLSORT="T":"Tribe of Membership",1:"Service Unit of Residence"),?30,"Reg Pts",?46,"Patients",?56," All"
W !,$S(APCLSORT="C":" residence",1:""),?30,"Living",?46,"Rec'ing",?56," PCC",?65," APC",?73,"PCP"
W !,$S(APCLSUB=1&(APCLSORT="C"):" Tribe of Membership",APCLSUB=1&(APCLSORT'="C"):" Community of Residence",1:""),?30,"As of Today",?46,"Service",?56," Srvs",?65,"Visits",?73,"Visits"
W !,APCL80D
Q
APCLPCT1 ; IHS/CMI/LAB - CONT OF APCLPCT 7/13/89 1:06 PM ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;PRINT INDIAN PATIENT COUNTS FOR SERVICE UNIT
START ;
+1 ;80 DASHES
SET APCL80D="--------------------------------------------------------------------------------"
+2 IF APCLFS="S"
SET (APCLSUP,APCLSUN)=$PIECE(^AUTTSU(APCLSU,0),U)
+3 IF APCLFS="F"
SET APCLSUP=$PIECE(^DIC(4,APCLSU,0),U)
SET APCLSUN=$PIECE(^AUTTSU(APCLSUF,0),U)
+4 SET (APCL1,APCL2,APCL3,APCL4,APCL5,APCLPG)=0
DO HEAD
+5 SET APCLMAJ=0
KILL APCLQUIT
+6 FOR I=0:0
SET APCLMAJ=$ORDER(^XTMP("APCLPCT",APCLJOB,APCLBT,APCLMAJ))
IF APCLMAJ=""!($DATA(APCLQUIT))
QUIT
DO MINOR
+7 IF $DATA(APCLQUIT)
GOTO DONE
+8 IF $Y>(IOSL-8)
DO HEAD
IF $DATA(APCLQUIT)
GOTO DONE
+9 WRITE !!?33,"------",?46,"------",?56,"------",?65,"------",?73,"------",!
+10 WRITE ?21,"Total:",?33,$JUSTIFY(APCL1,6),?46,$JUSTIFY(APCL2,6),?56,$JUSTIFY(APCL3,6),?65,$JUSTIFY(APCL4,6),?73,$JUSTIFY(APCL5,6),!
DONE ;
+1 DO DONE^APCLOSUT
+2 KILL ^XTMP("APCLPCT",APCLJOB,APCLBT),^XTMP("APCLPCTR",APCLJOB,APCLBT)
+3 QUIT
MINOR ;
+1 IF $Y>(IOSL-$SELECT(APCLSUB=1:9,1:6))
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+2 WRITE !,$EXTRACT(APCLMAJ,1,28)
IF APCLSUB=1
WRITE !
+3 SET APCLMIN=0
FOR
SET APCLMIN=$ORDER(^XTMP("APCLPCT",APCLJOB,APCLBT,APCLMAJ,APCLMIN))
IF APCLMIN=""!($DATA(APCLQUIT))
QUIT
DO MINOR1
+4 IF $DATA(APCLQUIT)
QUIT
+5 DO MAJTOT
+6 QUIT
MINOR1 ;
+1 IF '$DATA(^XTMP("APCLPCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ))
SET ^XTMP("APCLPCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ)="0^0^0^0^0"
+2 FOR APCLI=1:1:5
SET $PIECE(^XTMP("APCLPCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ),U,APCLI)=$PIECE(^XTMP("APCLPCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ),U,APCLI)+$PIECE(^XTMP("APCLPCT",APCLJOB,APCLBT,APCLMAJ,APCLMIN),U,APCLI)
+3 SET APCLP=1
FOR APCLI=1:1:5
SET APCLVAR="APCLT"_APCLI
SET @APCLVAR=$PIECE(^XTMP("APCLPCT",APCLJOB,APCLBT,APCLMAJ,APCLMIN),U,APCLP)
IF @APCLVAR=""
SET @APCLVAR=0
SET APCLP=APCLP+1
+4 FOR APCLI=1:1:5
SET APCLVAR1="APCL"_APCLI
SET APCLVAR2="APCLT"_APCLI
SET @APCLVAR1=@APCLVAR1+@APCLVAR2
+5 IF APCLSUB'=1
QUIT
+6 IF $Y>(IOSL-7)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+7 WRITE !?3,$EXTRACT(APCLMIN,1,25)
FOR APCLI=1:1:5
SET APCLVAR="APCLT"_APCLI
SET APCLT=$PIECE("33,46,57,65,73",",",APCLI)
WRITE ?APCLT,$JUSTIFY((@APCLVAR),6)
+8 QUIT
MAJTOT ;print major sort totals
+1 ;I $Y>(IOSL-7) D HEAD Q:$D(APCLQUIT)
+2 IF APCLSUB'=1
GOTO MAJTOT1
+3 WRITE !!?33,"------",?46,"------",?56,"------",?65,"------",?73,"------",!
+4 WRITE ?19,"Subtotal:"
MAJTOT1 SET APCLP=1
FOR APCLI=33,46,57,65,73
WRITE ?APCLI,$JUSTIFY($PIECE(^XTMP("APCLPCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ),U,APCLP),6)
SET APCLP=APCLP+1
+1 WRITE !
+2 QUIT
HEAD IF 'APCLPG
GOTO HEAD1
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET APCLPG=APCLPG+1
+2 WRITE $PIECE(^DIC(4,DUZ(2),0),U),?60,APCLDTP,?72,"Page ",APCLPG,!
+3 WRITE !,"Registration and Visit Counts for ",$SELECT(APCLIND=1:"Indian",1:"all")," Patients registered ",$SELECT(APCLFS="F":"at ",1:"in ")
+4 WRITE !,APCLSUP," ",$SELECT(APCLFS="F":"Facility",1:"Service Unit"),".",!
+5 WRITE "The report is sorted by ",$SELECT(APCLSORT="C":"Community of Residence",APCLSORT="T":"Tribe of Membership",1:"Service Unit of Residence"),$SELECT(APCLSUB=1:" and by ",1:".")
+6 IF APCLSUB=1
WRITE $SELECT(APCLSORT="C":"Tribe of Membership.",1:"Community of Residence.")
+7 WRITE !,"A '*' after the Community name indicates a Non-Service Unit Community.",!
+8 WRITE "Visit Counts between ",APCLSDY," and ",APCLEDY,".",!
+9 WRITE !,$SELECT(APCLSORT="C":"Current Community of",APCLSORT="T":"Tribe of Membership",1:"Service Unit of Residence"),?30,"Reg Pts",?46,"Patients",?56," All"
+10 WRITE !,$SELECT(APCLSORT="C":" residence",1:""),?30,"Living",?46,"Rec'ing",?56," PCC",?65," APC",?73,"PCP"
+11 WRITE !,$SELECT(APCLSUB=1&(APCLSORT="C"):" Tribe of Membership",APCLSUB=1&(APCLSORT'="C"):" Community of Residence",1:""),?30,"As of Today",?46,"Service",?56," Srvs",?65,"Visits",?73,"Visits"
+12 WRITE !,APCL80D
+13 QUIT
