APCLAP3P ; IHS/CMI/LAB - print visits by prov ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
START ;
S APCL80S="-------------------------------------------------------------------------------"
S Y=APCLED D DD^%DT S APCLEDD=Y
D NOW^%DTC S Y=X D DD^%DT S APCLDT=Y
S (APCLTOT,APCLPG)=0 D HEAD
S (APCLTOT,APCLPOS)=0 K APCLQUIT
F S APCLPOS=$O(^XTMP("APCLAP3",APCLJOB,APCLBTH,APCLPOS)) Q:APCLPOS=""!($D(APCLQUIT)) D P
G:$D(APCLQUIT) DONE
I $Y>(IOSL-5) D HEAD G:$D(APCLQUIT) DONE
W !!?53,"-------",!
W ?15,"Total Number of Provider Contacts:",?53,$J(APCLTOT,6),!
DONE ;
D DONE^APCLOSUT
K ^XTMP("APCLAP3",APCLJOB,APCLBTH)
Q
P ;
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
W !!,"Provider ",$S(APCLPSRT="D":"Discipline",APCLPSRT="A":"Discipline",1:"of Service"),": "
W $S(APCLPSRT="D":$P(^DIC(7,APCLPOS,0),U),APCLPSRT="A":$P(^DIC(7,APCLPOS,0),U),1:$S($P(^DD(9000010.06,.01,0),U,2)[200:$P(^VA(200,APCLPOS,0),U),1:$P(^DIC(16,APCLPOS,0),U)))
I APCLPSRT'="D",APCLPSRT'="A" W " [",$$VAL^XBDIQ1(200,APCLPOS,53.5),"]"
S APCLVLOC=0 F S APCLVLOC=$O(^XTMP("APCLAP3",APCLJOB,APCLBTH,APCLPOS,APCLVLOC)) Q:APCLVLOC'=+APCLVLOC!($D(APCLQUIT)) D
. W !?5,$P(^DIC(4,APCLVLOC,0),U)
. S APCLCAT="" F S APCLCAT=$O(^XTMP("APCLAP3",APCLJOB,APCLBTH,APCLPOS,APCLVLOC,APCLCAT)) Q:APCLCAT=""!($D(APCLQUIT)) D
.. I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
.. W !?10,APCLCAT,?53,$J(^XTMP("APCLAP3",APCLJOB,APCLBTH,APCLPOS,APCLVLOC,APCLCAT),6)
Q:$D(APCLQUIT)
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
W !?53,"------",!?40,"Subtotal: ",?53,$J(^XTMP("APCLAP3",APCLJOB,APCLBTH,APCLPOS,"TOTAL"),6)
S APCLTOT=APCLTOT+^XTMP("APCLAP3",APCLJOB,APCLBTH,APCLPOS,"TOTAL")
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 !
W ?58,APCLDT,?72,"Page ",APCLPG,!
W !?9,"NUMBER OF CONTACTS BY PROVIDER, LOCATION AND SERVICE CATEGORY"
S APCLLOCT=$S(APCLLOC=0:"ALL",1:"SELECTED")
S APCLPROT=$S(APCLPSRT="D":"PROVIDER DISCIPLINE: ",APCLPSRT="A":"PROVIDER DISCIPLINE: ",1:"PROVIDER OF SERVICE: ")
S APCLPROS=$S(APCLPSRT="D":$P(^DIC(7,APCLDISC,0),U),APCLPSRT="P":"ALL",APCLPSRT="A":"ALL",1:$S($P(^DD(9000010.06,.01,0),U,2)[200:$P(^VA(200,APCLPROV,0),U),1:$P(^DIC(16,APCLPROV,0),U)))
S APCLLENG=21+$L(APCLLOCT)
W !?((80-APCLLENG)/2),"LOCATION OF VISITS: ",APCLLOCT,!
S APCLLENG=$L(APCLPROT)+$L(APCLPROS)
W ?((80-APCLLENG)/2),APCLPROT,APCLPROS,!
S APCLTAB=$S(APCLPRIM:29,1:20),APCLTEXT=$S(APCLPRIM:"PRIMARY PROVIDER ONLY",1:"PRIMARY AND SECONDARY PROVIDERS INCLUDED")
W ?APCLTAB,APCLTEXT,!
W ?18,"VISIT DATES: ",APCLBDD," TO ",APCLEDD,!
W !?5,"LOCATION OF VISIT"
W !?10,"SERVICE CATEGORY",?50,"# PROVIDER CONTACTS",!
W APCL80S
Q
APCLAP3P ; IHS/CMI/LAB - print visits by prov ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
START ;
+1 SET APCL80S="-------------------------------------------------------------------------------"
+2 SET Y=APCLED
DO DD^%DT
SET APCLEDD=Y
+3 DO NOW^%DTC
SET Y=X
DO DD^%DT
SET APCLDT=Y
+4 SET (APCLTOT,APCLPG)=0
DO HEAD
+5 SET (APCLTOT,APCLPOS)=0
KILL APCLQUIT
+6 FOR
SET APCLPOS=$ORDER(^XTMP("APCLAP3",APCLJOB,APCLBTH,APCLPOS))
IF APCLPOS=""!($DATA(APCLQUIT))
QUIT
DO P
+7 IF $DATA(APCLQUIT)
GOTO DONE
+8 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
GOTO DONE
+9 WRITE !!?53,"-------",!
+10 WRITE ?15,"Total Number of Provider Contacts:",?53,$JUSTIFY(APCLTOT,6),!
DONE ;
+1 DO DONE^APCLOSUT
+2 KILL ^XTMP("APCLAP3",APCLJOB,APCLBTH)
+3 QUIT
P ;
+1 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+2 WRITE !!,"Provider ",$SELECT(APCLPSRT="D":"Discipline",APCLPSRT="A":"Discipline",1:"of Service"),": "
+3 WRITE $SELECT(APCLPSRT="D":$PIECE(^DIC(7,APCLPOS,0),U),APCLPSRT="A":$PIECE(^DIC(7,APCLPOS,0),U),1:$SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:$PIECE(^VA(200,APCLPOS,0),U),1:$PIECE(^DIC(16,APCLPOS,0),U)))
+4 IF APCLPSRT'="D"
IF APCLPSRT'="A"
WRITE " [",$$VAL^XBDIQ1(200,APCLPOS,53.5),"]"
+5 SET APCLVLOC=0
FOR
SET APCLVLOC=$ORDER(^XTMP("APCLAP3",APCLJOB,APCLBTH,APCLPOS,APCLVLOC))
IF APCLVLOC'=+APCLVLOC!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+6 WRITE !?5,$PIECE(^DIC(4,APCLVLOC,0),U)
+7 SET APCLCAT=""
FOR
SET APCLCAT=$ORDER(^XTMP("APCLAP3",APCLJOB,APCLBTH,APCLPOS,APCLVLOC,APCLCAT))
IF APCLCAT=""!($DATA(APCLQUIT))
QUIT
Begin DoDot:2
+8 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+9 WRITE !?10,APCLCAT,?53,$JUSTIFY(^XTMP("APCLAP3",APCLJOB,APCLBTH,APCLPOS,APCLVLOC,APCLCAT),6)
End DoDot:2
End DoDot:1
+10 IF $DATA(APCLQUIT)
QUIT
+11 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+12 WRITE !?53,"------",!?40,"Subtotal: ",?53,$JUSTIFY(^XTMP("APCLAP3",APCLJOB,APCLBTH,APCLPOS,"TOTAL"),6)
+13 SET APCLTOT=APCLTOT+^XTMP("APCLAP3",APCLJOB,APCLBTH,APCLPOS,"TOTAL")
+14 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 !
+3 WRITE ?58,APCLDT,?72,"Page ",APCLPG,!
+4 WRITE !?9,"NUMBER OF CONTACTS BY PROVIDER, LOCATION AND SERVICE CATEGORY"
+5 SET APCLLOCT=$SELECT(APCLLOC=0:"ALL",1:"SELECTED")
+6 SET APCLPROT=$SELECT(APCLPSRT="D":"PROVIDER DISCIPLINE: ",APCLPSRT="A":"PROVIDER DISCIPLINE: ",1:"PROVIDER OF SERVICE: ")
+7 SET APCLPROS=$SELECT(APCLPSRT="D":$PIECE(^DIC(7,APCLDISC,0),U),APCLPSRT="P":"ALL",APCLPSRT="A":"ALL",1:$SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:$PIECE(^VA(200,APCLPROV,0),U),1:$PIECE(^DIC(16,APCLPROV,0),U)))
+8 SET APCLLENG=21+$LENGTH(APCLLOCT)
+9 WRITE !?((80-APCLLENG)/2),"LOCATION OF VISITS: ",APCLLOCT,!
+10 SET APCLLENG=$LENGTH(APCLPROT)+$LENGTH(APCLPROS)
+11 WRITE ?((80-APCLLENG)/2),APCLPROT,APCLPROS,!
+12 SET APCLTAB=$SELECT(APCLPRIM:29,1:20)
SET APCLTEXT=$SELECT(APCLPRIM:"PRIMARY PROVIDER ONLY",1:"PRIMARY AND SECONDARY PROVIDERS INCLUDED")
+13 WRITE ?APCLTAB,APCLTEXT,!
+14 WRITE ?18,"VISIT DATES: ",APCLBDD," TO ",APCLEDD,!
+15 WRITE !?5,"LOCATION OF VISIT"
+16 WRITE !?10,"SERVICE CATEGORY",?50,"# PROVIDER CONTACTS",!
+17 WRITE APCL80S
+18 QUIT
