APCLACC1 ; IHS/CMI/LAB - process active user report ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;IHS/CMI/LAB - added template creation
;PRINT INDIAN PATIENT COUNTS FOR SERVICE UNIT
START ;
K APCLSUP
S APCL80D="--------------------------------------------------------------------------------" ;80 DASHES
;S:APCLFS="S" (APCLSUP,APCLSUN)=$P(^AUTTSU(APCLSU,0),U)
I APCLFS="S" S X=0 F S X=$O(APCLSU(X)) Q:X'=+X S APCLSUP($P(^AUTTSU(X,0),U))=$P(^AUTTSU(X,0),U)
;I APCLFS="F" S APCLSUP=$P(^DIC(4,APCLSU,0),U),APCLSUN=$P(^AUTTSU(APCLSUF,0),U)
I APCLFS="F" S X=0 F S X=$O(APCLSU(X)) Q:X'=+X S APCLSUP($P(^DIC(4,X,0),U))=$S($P(^AUTTLOC(X,0),U,5):$P(^AUTTSU($P(^AUTTLOC(X,0),U,5),0),U),1:"??")
S (APCL1,APCL2,APCLPG)=0 D HEAD
I APCLRPTT="T" D TEMPLATE G DONE
S APCLMAJ=0 K APCLQUIT
F I=0:0 S APCLMAJ=$O(^XTMP("APCLACC",APCLJOB,APCLBT,APCLMAJ)) Q:APCLMAJ=""!($D(APCLQUIT)) D MINOR
G:$D(APCLQUIT) DONE
I $Y>(IOSL-7) D HEAD G:$D(APCLQUIT) DONE
W !!?50,"------",?67,"------",!
W ?39,"Total:",?50,$J(APCL1,6),?67,$J(APCL2,6),!
DONE ;
D DONE^APCLOSUT
K ^XTMP("APCLACC",APCLJOB,APCLBT),^XTMP("APCLACCR",APCLJOB,APCLBT),^XTMP("APCLACC SU",APCLJOB,APCLBT)
Q
MINOR ;
I $Y>(IOSL-$S(APCLSUB=1:9,1:6)) D HEAD Q:$D(APCLQUIT)
W !,APCLMAJ W:APCLSUB=1 !
S APCLMIN=0 F S APCLMIN=$O(^XTMP("APCLACC",APCLJOB,APCLBT,APCLMAJ,APCLMIN)) Q:APCLMIN=""!($D(APCLQUIT)) D MINOR1
Q:$D(APCLQUIT)
D MAJTOT
Q
MINOR1 ;
S:'$D(^XTMP("APCLACCR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ)) ^XTMP("APCLACCR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ)="0^0"
F APCLI=1:1:2 S $P(^XTMP("APCLACCR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ),U,APCLI)=$P(^XTMP("APCLACCR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ),U,APCLI)+$P(^XTMP("APCLACC",APCLJOB,APCLBT,APCLMAJ,APCLMIN),U,APCLI)
S APCLP=1 F APCLI=1:1:2 S APCLVAR="APCLT"_APCLI,@APCLVAR=$P(^XTMP("APCLACC",APCLJOB,APCLBT,APCLMAJ,APCLMIN),U,APCLP) S:@APCLVAR="" @APCLVAR=0 S APCLP=APCLP+1
F APCLI=1:1:2 S APCLVAR1="APCL"_APCLI,APCLVAR2="APCLT"_APCLI S @APCLVAR1=@APCLVAR1+@APCLVAR2
Q:APCLSUB'=1
I $Y>(IOSL-6) D HEAD Q:$D(APCLQUIT)
W !?5,$E(APCLMIN,1,45) F APCLI=1:1:2 S APCLVAR="APCLT"_APCLI S APCLT=$P("50,67",",",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 !?50,"------",?67,"------",!
W ?39,"Subtotal:"
MAJTOT1 S APCLP=1 F APCLI=50,67 W ?APCLI,$J($P(^XTMP("APCLACCR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ),U,APCLP),6) S APCLP=APCLP+1
W !
Q
TEMPLATE ;create template
;create search template
K DD,D0,DO,DIC S DIC="^DIBT(",DIC(0)="LM",X="ACTIVE USERS AS OF "_$$FMTE^XLFDT(APCLFYE,"2E") D ^DIC K DIC,DA,D0,DD
I Y=-1 W !!,"SEARCH TEMPLATE CREATION FAILED." Q
K ^DIBT(+Y,1)
S APCLSTMP=+Y
S DIE="^DIBT(",DA=APCLSTMP,DR="2////"_DT_";3////M;4////9000001;5////"_DUZ_";6////M"
D ^DIE
K DIE,DA,DR S Y=0 F S Y=$O(^XTMP("APCLACC",APCLJOB,APCLBT,"TEMPLATE PATIENTS",Y)) Q:Y'=+Y S ^DIBT(APCLSTMP,1,Y)=""""
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 Active Patient Counts for ",$S(APCLIND=1:"Indian",1:"all")," Patients registered ",$S(APCLFS="F":"at ",1:"in ")
S %="the following "_$S(APCLFS="F":"Facilities",1:"Service Units")_":"
W !,%
S %="",X="" F S X=$O(APCLSUP(X)) Q:X="" S %=%_" "_X
W !?((80-$L(%))/2),%
W:APCLRPTT'="T" !,"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:".")
I $G(APCLSUB)=1,APCLRPTT'="T" W $S(APCLSORT="C":"Tribe of Membership.",1:"Community of Residence.")
W !
W:APCLSSUR=0 !,"A '*' after the Community name indicates a Non-Service Unit Community.",!
W:APCLSSUR=1 !,"Report includes only those patients who reside in a Service Unit Community.",!
W "Active Patient were those seen between ",APCLFYBY," and ",APCLFYEY,".",!
I APCLRPTT="T" W !!!,"***** SEARCH TEMPLATE 'ACTIVE USERS AS OF "_$$FMTE^XLFDT(APCLFYE,"2E")_"' HAS BEEN CREATED ****" Q
W !,$S(APCLSORT="C":"Current Community of Residence",APCLSORT="T":"Tribe of Membership",1:"Service Unit of Residence"),?50,"Reg Pts Living",?67,"Active"
W !,$S(APCLSUB=1&(APCLSORT="C"):" Tribe of Membership",APCLSUB=1&(APCLSORT'="C"):" Community of Residence",1:""),?50,"As of Today",?67,"Patients"
W !,APCL80D
Q
APCLACC1 ; IHS/CMI/LAB - process active user report ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;IHS/CMI/LAB - added template creation
+3 ;PRINT INDIAN PATIENT COUNTS FOR SERVICE UNIT
START ;
+1 KILL APCLSUP
+2 ;80 DASHES
SET APCL80D="--------------------------------------------------------------------------------"
+3 ;S:APCLFS="S" (APCLSUP,APCLSUN)=$P(^AUTTSU(APCLSU,0),U)
+4 IF APCLFS="S"
SET X=0
FOR
SET X=$ORDER(APCLSU(X))
IF X'=+X
QUIT
SET APCLSUP($PIECE(^AUTTSU(X,0),U))=$PIECE(^AUTTSU(X,0),U)
+5 ;I APCLFS="F" S APCLSUP=$P(^DIC(4,APCLSU,0),U),APCLSUN=$P(^AUTTSU(APCLSUF,0),U)
+6 IF APCLFS="F"
SET X=0
FOR
SET X=$ORDER(APCLSU(X))
IF X'=+X
QUIT
SET APCLSUP($PIECE(^DIC(4,X,0),U))=$SELECT($PIECE(^AUTTLOC(X,0),U,5):$PIECE(^AUTTSU($PIECE(^AUTTLOC(X,0),U,5),0),U),1:"??")
+7 SET (APCL1,APCL2,APCLPG)=0
DO HEAD
+8 IF APCLRPTT="T"
DO TEMPLATE
GOTO DONE
+9 SET APCLMAJ=0
KILL APCLQUIT
+10 FOR I=0:0
SET APCLMAJ=$ORDER(^XTMP("APCLACC",APCLJOB,APCLBT,APCLMAJ))
IF APCLMAJ=""!($DATA(APCLQUIT))
QUIT
DO MINOR
+11 IF $DATA(APCLQUIT)
GOTO DONE
+12 IF $Y>(IOSL-7)
DO HEAD
IF $DATA(APCLQUIT)
GOTO DONE
+13 WRITE !!?50,"------",?67,"------",!
+14 WRITE ?39,"Total:",?50,$JUSTIFY(APCL1,6),?67,$JUSTIFY(APCL2,6),!
DONE ;
+1 DO DONE^APCLOSUT
+2 KILL ^XTMP("APCLACC",APCLJOB,APCLBT),^XTMP("APCLACCR",APCLJOB,APCLBT),^XTMP("APCLACC SU",APCLJOB,APCLBT)
+3 QUIT
MINOR ;
+1 IF $Y>(IOSL-$SELECT(APCLSUB=1:9,1:6))
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+2 WRITE !,APCLMAJ
IF APCLSUB=1
WRITE !
+3 SET APCLMIN=0
FOR
SET APCLMIN=$ORDER(^XTMP("APCLACC",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("APCLACCR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ))
SET ^XTMP("APCLACCR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ)="0^0"
+2 FOR APCLI=1:1:2
SET $PIECE(^XTMP("APCLACCR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ),U,APCLI)=$PIECE(^XTMP("APCLACCR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ),U,APCLI)+$PIECE(^XTMP("APCLACC",APCLJOB,APCLBT,APCLMAJ,APCLMIN),U,APCLI)
+3 SET APCLP=1
FOR APCLI=1:1:2
SET APCLVAR="APCLT"_APCLI
SET @APCLVAR=$PIECE(^XTMP("APCLACC",APCLJOB,APCLBT,APCLMAJ,APCLMIN),U,APCLP)
IF @APCLVAR=""
SET @APCLVAR=0
SET APCLP=APCLP+1
+4 FOR APCLI=1:1:2
SET APCLVAR1="APCL"_APCLI
SET APCLVAR2="APCLT"_APCLI
SET @APCLVAR1=@APCLVAR1+@APCLVAR2
+5 IF APCLSUB'=1
QUIT
+6 IF $Y>(IOSL-6)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+7 WRITE !?5,$EXTRACT(APCLMIN,1,45)
FOR APCLI=1:1:2
SET APCLVAR="APCLT"_APCLI
SET APCLT=$PIECE("50,67",",",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 !?50,"------",?67,"------",!
+4 WRITE ?39,"Subtotal:"
MAJTOT1 SET APCLP=1
FOR APCLI=50,67
WRITE ?APCLI,$JUSTIFY($PIECE(^XTMP("APCLACCR",APCLJOB,APCLBT,"SUBTOTAL",APCLMAJ),U,APCLP),6)
SET APCLP=APCLP+1
+1 WRITE !
+2 QUIT
TEMPLATE ;create template
+1 ;create search template
+2 KILL DD,D0,DO,DIC
SET DIC="^DIBT("
SET DIC(0)="LM"
SET X="ACTIVE USERS AS OF "_$$FMTE^XLFDT(APCLFYE,"2E")
DO ^DIC
KILL DIC,DA,D0,DD
+3 IF Y=-1
WRITE !!,"SEARCH TEMPLATE CREATION FAILED."
QUIT
+4 KILL ^DIBT(+Y,1)
+5 SET APCLSTMP=+Y
+6 SET DIE="^DIBT("
SET DA=APCLSTMP
SET DR="2////"_DT_";3////M;4////9000001;5////"_DUZ_";6////M"
+7 DO ^DIE
+8 KILL DIE,DA,DR
SET Y=0
FOR
SET Y=$ORDER(^XTMP("APCLACC",APCLJOB,APCLBT,"TEMPLATE PATIENTS",Y))
IF Y'=+Y
QUIT
SET ^DIBT(APCLSTMP,1,Y)=""""
+9 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 Active Patient Counts for ",$SELECT(APCLIND=1:"Indian",1:"all")," Patients registered ",$SELECT(APCLFS="F":"at ",1:"in ")
+4 SET %="the following "_$SELECT(APCLFS="F":"Facilities",1:"Service Units")_":"
+5 WRITE !,%
+6 SET %=""
SET X=""
FOR
SET X=$ORDER(APCLSUP(X))
IF X=""
QUIT
SET %=%_" "_X
+7 WRITE !?((80-$LENGTH(%))/2),%
+8 IF APCLRPTT'="T"
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:".")
+9 IF $GET(APCLSUB)=1
IF APCLRPTT'="T"
WRITE $SELECT(APCLSORT="C":"Tribe of Membership.",1:"Community of Residence.")
+10 WRITE !
+11 IF APCLSSUR=0
WRITE !,"A '*' after the Community name indicates a Non-Service Unit Community.",!
+12 IF APCLSSUR=1
WRITE !,"Report includes only those patients who reside in a Service Unit Community.",!
+13 WRITE "Active Patient were those seen between ",APCLFYBY," and ",APCLFYEY,".",!
+14 IF APCLRPTT="T"
WRITE !!!,"***** SEARCH TEMPLATE 'ACTIVE USERS AS OF "_$$FMTE^XLFDT(APCLFYE,"2E")_"' HAS BEEN CREATED ****"
QUIT
+15 WRITE !,$SELECT(APCLSORT="C":"Current Community of Residence",APCLSORT="T":"Tribe of Membership",1:"Service Unit of Residence"),?50,"Reg Pts Living",?67,"Active"
+16 WRITE !,$SELECT(APCLSUB=1&(APCLSORT="C"):" Tribe of Membership",APCLSUB=1&(APCLSORT'="C"):" Community of Residence",1:""),?50,"As of Today",?67,"Patients"
+17 WRITE !,APCL80D
+18 QUIT
