APCLHCT1 ; IHS/CMI/LAB - CONT OF APCLHCT 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 (APCL1,APCL2,APCL3,APCL4,APCL5,APCL6,APCL7,APCL8,APCLPG)=0 D HEAD
S APCLMAJ=0 K APCLQUIT
F I=0:0 S APCLMAJ=$O(^XTMP("APCLHCT",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,"-------",?59,"-------",?70,"-------",!
W !!
F J=24,31,38,45,52,59,66,73 W ?J,"-------"
W !
W ?12,"Total:",?24,$$C(APCL1,0,7),?31,$$C(APCL2,0,7),?38,$$C(APCL3,0,7),?45,$$C(APCL4,0,7),?52,$$C(APCL5,0,7),?59,$$C(APCL6,0,7),?66,$$C(APCL7,0,7),?73,$$C(APCL8,0,7),!
DONE ;
D DONE^APCLOSUT
K ^XTMP("APCLHCT",APCLJOB,APCLBT),^XTMP("APCLHCTR",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("APCLHCT",APCLJOB,APCLBT,APCLMAJ,APCLMIN)) Q:APCLMIN=""!($D(APCLQUIT)) D MINOR1
Q:$D(APCLQUIT)
D MAJTOT
Q
MINOR1 ;
S:'$D(^XTMP("APCLHCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ)) ^XTMP("APCLHCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ)="0^0^0^0^0^0^0^0"
F APCLI=1:1:8 S $P(^XTMP("APCLHCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ),U,APCLI)=$P(^XTMP("APCLHCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ),U,APCLI)+$P(^XTMP("APCLHCT",APCLJOB,APCLBT,APCLMAJ,APCLMIN),U,APCLI)
S APCLP=1 F APCLI=1:1:8 S APCLVAR="APCLT"_APCLI,@APCLVAR=$P(^XTMP("APCLHCT",APCLJOB,APCLBT,APCLMAJ,APCLMIN),U,APCLP) S:@APCLVAR="" @APCLVAR=0 S APCLP=APCLP+1
F APCLI=1:1:8 S APCLVAR1="APCL"_APCLI,APCLVAR2="APCLT"_APCLI S @APCLVAR1=@APCLVAR1+@APCLVAR2
Q:APCLSUB'=1
I $Y>(IOSL-7) D HEAD Q:$D(APCLQUIT)
W !?1,$E(APCLMIN,1,20) F APCLI=1:1:8 S APCLVAR="APCLT"_APCLI S APCLT=$P("24,31,38,45,52,59,66,73",",",APCLI) W ?APCLT,$$C((@APCLVAR),0,7)
Q
MAJTOT ;print major sort totals
;I $Y>(IOSL-7) D HEAD Q:$D(APCLQUIT)
G:APCLSUB'=1 MAJTOT1
W !!
F J=24,31,38,45,52,59,66,73 W ?J,"-------"
W !
;?24,"-------",?46,"-------",?59,"-------",?70,"-------",!
W ?12,"Subtotal:"
MAJTOT1 S APCLP=1 F APCLI=24,31,38,45,52,59,66,73 W ?APCLI,$$C($P(^XTMP("APCLHCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ),U,APCLP),0,7) S APCLP=APCLP+1
W !
Q
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;---------
C(X,X2,X3) ;
D COMMA^%DTC
Q X
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 !,"Inpatient Discharges and Days for ",$S(APCLIND=1:"Indian",1:"all")," Patients."
S X="Location of Hospitalization: "_$P(^DIC(4,APCLLOC,0),U) W !,$$CTR(X,80)
W !,"Discharge Dates between ",APCLSDY," and ",APCLEDY,".",!
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 !,$S(APCLSORT="C":"Current Community of",APCLSORT="T":"Tribe of Membership",1:"Service Unit of Residence")
W ?24,"# Adult",?32,"# Adult",?40,"# NB",?47,"# NB",?54,"# TX",?61,"# MCR",?68,"# MCD",?74,"# PI"
W !,$S(APCLSORT="C":" residence",1:""),?24,"/Peds",?32,"/Peds",?40,"Dsch",?47,"Days",?54,"IN"
W !?24,"Dsch",?32,"Days"
W !,$S(APCLSUB=1&(APCLSORT="C"):" Tribe of Membership",APCLSUB=1&(APCLSORT'="C"):" Community of Residence",1:"")
W !,$$REPEAT^XLFSTR("-",80)
Q
APCLHCT1 ; IHS/CMI/LAB - CONT OF APCLHCT 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 SET (APCL1,APCL2,APCL3,APCL4,APCL5,APCL6,APCL7,APCL8,APCLPG)=0
DO HEAD
+3 SET APCLMAJ=0
KILL APCLQUIT
+4 FOR I=0:0
SET APCLMAJ=$ORDER(^XTMP("APCLHCT",APCLJOB,APCLBT,APCLMAJ))
IF APCLMAJ=""!($DATA(APCLQUIT))
QUIT
DO MINOR
+5 IF $DATA(APCLQUIT)
GOTO DONE
+6 IF $Y>(IOSL-8)
DO HEAD
IF $DATA(APCLQUIT)
GOTO DONE
+7 ;W !!?33,"-------",?46,"-------",?59,"-------",?70,"-------",!
+8 WRITE !!
+9 FOR J=24,31,38,45,52,59,66,73
WRITE ?J,"-------"
+10 WRITE !
+11 WRITE ?12,"Total:",?24,$$C(APCL1,0,7),?31,$$C(APCL2,0,7),?38,$$C(APCL3,0,7),?45,$$C(APCL4,0,7),?52,$$C(APCL5,0,7),?59,$$C(APCL6,0,7),?66,$$C(APCL7,0,7),?73,$$C(APCL8,0,7),!
DONE ;
+1 DO DONE^APCLOSUT
+2 KILL ^XTMP("APCLHCT",APCLJOB,APCLBT),^XTMP("APCLHCTR",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("APCLHCT",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("APCLHCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ))
SET ^XTMP("APCLHCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ)="0^0^0^0^0^0^0^0"
+2 FOR APCLI=1:1:8
SET $PIECE(^XTMP("APCLHCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ),U,APCLI)=$PIECE(^XTMP("APCLHCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ),U,APCLI)+$PIECE(^XTMP("APCLHCT",APCLJOB,APCLBT,APCLMAJ,APCLMIN),U,APCLI)
+3 SET APCLP=1
FOR APCLI=1:1:8
SET APCLVAR="APCLT"_APCLI
SET @APCLVAR=$PIECE(^XTMP("APCLHCT",APCLJOB,APCLBT,APCLMAJ,APCLMIN),U,APCLP)
IF @APCLVAR=""
SET @APCLVAR=0
SET APCLP=APCLP+1
+4 FOR APCLI=1:1:8
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 !?1,$EXTRACT(APCLMIN,1,20)
FOR APCLI=1:1:8
SET APCLVAR="APCLT"_APCLI
SET APCLT=$PIECE("24,31,38,45,52,59,66,73",",",APCLI)
WRITE ?APCLT,$$C((@APCLVAR),0,7)
+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 !!
+4 FOR J=24,31,38,45,52,59,66,73
WRITE ?J,"-------"
+5 WRITE !
+6 ;?24,"-------",?46,"-------",?59,"-------",?70,"-------",!
+7 WRITE ?12,"Subtotal:"
MAJTOT1 SET APCLP=1
FOR APCLI=24,31,38,45,52,59,66,73
WRITE ?APCLI,$$C($PIECE(^XTMP("APCLHCTR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ),U,APCLP),0,7)
SET APCLP=APCLP+1
+1 WRITE !
+2 QUIT
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;---------
C(X,X2,X3) ;
+1 DO COMMA^%DTC
+2 QUIT X
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 !,"Inpatient Discharges and Days for ",$SELECT(APCLIND=1:"Indian",1:"all")," Patients."
+4 SET X="Location of Hospitalization: "_$PIECE(^DIC(4,APCLLOC,0),U)
WRITE !,$$CTR(X,80)
+5 WRITE !,"Discharge Dates between ",APCLSDY," and ",APCLEDY,".",!
+6 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:".")
+7 IF APCLSUB=1
WRITE $SELECT(APCLSORT="C":"Tribe of Membership.",1:"Community of Residence.")
+8 WRITE !,"A '*' after the Community name indicates a Non-Service Unit Community.",!
+9 WRITE !,$SELECT(APCLSORT="C":"Current Community of",APCLSORT="T":"Tribe of Membership",1:"Service Unit of Residence")
+10 WRITE ?24,"# Adult",?32,"# Adult",?40,"# NB",?47,"# NB",?54,"# TX",?61,"# MCR",?68,"# MCD",?74,"# PI"
+11 WRITE !,$SELECT(APCLSORT="C":" residence",1:""),?24,"/Peds",?32,"/Peds",?40,"Dsch",?47,"Days",?54,"IN"
+12 WRITE !?24,"Dsch",?32,"Days"
+13 WRITE !,$SELECT(APCLSUB=1&(APCLSORT="C"):" Tribe of Membership",APCLSUB=1&(APCLSORT'="C"):" Community of Residence",1:"")
+14 WRITE !,$$REPEAT^XLFSTR("-",80)
+15 QUIT
