- 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
