- APCLOSP2 ; IHS/CMI/LAB - PRINT AMB. SECTION ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- AMB ;
- I $Y>(IOSL-10) D HEAD^APCLOSP Q:$D(APCLQUIT)
- W !!,"AMBULATORY CARE VISITS"
- I '$D(^XTMP("APCLOS",APCLJOB,APCLBTH,"AMBVCOUNT")),'$D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"AMBVCOUNT")) W !?10,"[ NO AMBULATORY CARE VISITS TO REPORT ]",! Q
- S X=$S($D(^XTMP("APCLOS",APCLJOB,APCLBTH,"AMBVCOUNT")):^("AMBVCOUNT"),1:0),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,"AMBVCOUNT")):^("AMBVCOUNT"),1:0) D CALC^APCLOSUT
- W !!,"There were a total of ",X," ambulatory visits (",Z,") during the period for",!,"all visit types except CHS.",!
- W !,"They are broken down below by Type, Location, Service Category, Clinic,",!,"Provider Discipline and leading Diagnoses. These do not equate to 'official'",!,"APC Visits which are identified in other PCC Reports.",!
- TYPE ;
- S APCLPTR=0,APCLT="By Type:",APCL1="AMBTYPE",APCL2="AMBTYPEC",APCLTOT=0,APCLWC=0
- D PROC Q:$D(APCLQUIT)
- LOC ;
- S APCLPTR=1,APCLT="By Location:",APCL1="AMBLOC",APCL2="AMBLOCC",APCLTOT=0,APCLWC=0,APCLGLOB="^DIC(4,",APCLPIEC=1
- D PROC Q:$D(APCLQUIT)
- CAT ;
- S APCLPTR=0,APCLT="By Service Category:",APCL1="AMBCAT",APCL2="AMBCATC",APCLTOT=0,APCLWC=0
- D PROC Q:$D(APCLQUIT)
- CLINIC ;
- S APCLPTR=0,APCLT="By Clinic Type:",APCL1="AMBCLIN",APCL2="AMBCLINC",APCLTOT=0,APCLWC=0
- D PROC Q:$D(APCLQUIT)
- PROV ;
- S APCLPTR=0,APCLT="By Provider Type (Primary and Secondary Providers):",APCL1="AMBPROV",APCL2="AMBPROVC",APCLTOT=0,APCLWC=0
- D PROC Q:$D(APCLQUIT)
- D ^APCLOSP3
- EOJ ;ENTRY POINT
- K APCL1,APCL2,APCL3,APCLX,APCLTOTO,APCLTOTC,APCLLC,APCLT
- Q
- GETLINE ;
- S (APCLX,APCLTOTO,APCLTOTC,APCLLC)=0 F S APCLX=$O(^XTMP("APCLOS",APCLJOB,APCLBTH,APCL1,APCLX)) Q:APCLX="" S APCLLC=APCLLC+1,APCLTOTC=^XTMP("APCLOS",APCLJOB,APCLBTH,APCL1,APCLX)+APCLTOTC
- S APCLX=0 F S APCLX=$O(^XTMP("APCLOSP",APCLJOB,APCLBTH,APCL1,APCLX)) Q:APCLX="" S APCLTOTO=APCLTOTO+^XTMP("APCLOSP",APCLJOB,APCLBTH,APCL1,APCLX)
- Q
- PROC ;
- D GETLINE
- I $Y>(IOSL-9) D HEAD^APCLOSP Q:$D(APCLQUIT)
- W !!?10,APCLT
- S APCLN=0 F S APCLN=$O(^XTMP("APCLOS",APCLJOB,APCLBTH,APCL2,APCLN)) Q:APCLN=""!($D(APCLQUIT)) D PROC1
- D:APCLTOT=1 TOTAL
- Q
- PROC1 ;
- S APCLD=0 F S APCLD=$O(^XTMP("APCLOS",APCLJOB,APCLBTH,APCL2,APCLN,APCLD)) Q:APCLD="" D PRNT
- Q
- PRNT ;
- I $Y>(IOSL-5) D HEAD^APCLOSP Q:$D(APCLQUIT) W !?10,APCLT W:APCLWC>0 " (cont.)"
- S X=^XTMP("APCLOS",APCLJOB,APCLBTH,APCL2,APCLN,APCLD),Y=$S($D(^XTMP("APCLOSP",APCLJOB,APCLBTH,APCL1,APCLD)):^(APCLD),1:0) D CALC^APCLOSUT
- I APCLPTR=1 D PRNTPTR Q
- W !?13,APCLD,?45,$J(X,7),?55,"(",Z,")" S APCLWC=APCLWC+1
- Q
- PRNTPTR ;
- S G=APCLGLOB_APCLD_")"
- W !?13,$P(@G@(0),U,APCLPIEC),?45,$J(X,7),?55,"(",Z,")" S APCLWC=APCLWC+1
- Q
- TOTAL ;
- S X=APCLTOTC,Y=APCLTOTO D CALC^APCLOSUT
- W !?15,"TOTAL:",?45,$J(APCLTOTC,8),?55,"(",Z,")"
- Q
- APCLOSP2 ; IHS/CMI/LAB - PRINT AMB. SECTION ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- AMB ;
- +1 IF $Y>(IOSL-10)
- DO HEAD^APCLOSP
- IF $DATA(APCLQUIT)
- QUIT
- +2 WRITE !!,"AMBULATORY CARE VISITS"
- +3 IF '$DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"AMBVCOUNT"))
- IF '$DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"AMBVCOUNT"))
- WRITE !?10,"[ NO AMBULATORY CARE VISITS TO REPORT ]",!
- QUIT
- +4 SET X=$SELECT($DATA(^XTMP("APCLOS",APCLJOB,APCLBTH,"AMBVCOUNT")):^("AMBVCOUNT"),1:0)
- SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,"AMBVCOUNT")):^("AMBVCOUNT"),1:0)
- DO CALC^APCLOSUT
- +5 WRITE !!,"There were a total of ",X," ambulatory visits (",Z,") during the period for",!,"all visit types except CHS.",!
- +6 WRITE !,"They are broken down below by Type, Location, Service Category, Clinic,",!,"Provider Discipline and leading Diagnoses. These do not equate to 'official'",!,"APC Visits which are identified in other PCC Reports.",!
- TYPE ;
- +1 SET APCLPTR=0
- SET APCLT="By Type:"
- SET APCL1="AMBTYPE"
- SET APCL2="AMBTYPEC"
- SET APCLTOT=0
- SET APCLWC=0
- +2 DO PROC
- IF $DATA(APCLQUIT)
- QUIT
- LOC ;
- +1 SET APCLPTR=1
- SET APCLT="By Location:"
- SET APCL1="AMBLOC"
- SET APCL2="AMBLOCC"
- SET APCLTOT=0
- SET APCLWC=0
- SET APCLGLOB="^DIC(4,"
- SET APCLPIEC=1
- +2 DO PROC
- IF $DATA(APCLQUIT)
- QUIT
- CAT ;
- +1 SET APCLPTR=0
- SET APCLT="By Service Category:"
- SET APCL1="AMBCAT"
- SET APCL2="AMBCATC"
- SET APCLTOT=0
- SET APCLWC=0
- +2 DO PROC
- IF $DATA(APCLQUIT)
- QUIT
- CLINIC ;
- +1 SET APCLPTR=0
- SET APCLT="By Clinic Type:"
- SET APCL1="AMBCLIN"
- SET APCL2="AMBCLINC"
- SET APCLTOT=0
- SET APCLWC=0
- +2 DO PROC
- IF $DATA(APCLQUIT)
- QUIT
- PROV ;
- +1 SET APCLPTR=0
- SET APCLT="By Provider Type (Primary and Secondary Providers):"
- SET APCL1="AMBPROV"
- SET APCL2="AMBPROVC"
- SET APCLTOT=0
- SET APCLWC=0
- +2 DO PROC
- IF $DATA(APCLQUIT)
- QUIT
- +3 DO ^APCLOSP3
- EOJ ;ENTRY POINT
- +1 KILL APCL1,APCL2,APCL3,APCLX,APCLTOTO,APCLTOTC,APCLLC,APCLT
- +2 QUIT
- GETLINE ;
- +1 SET (APCLX,APCLTOTO,APCLTOTC,APCLLC)=0
- FOR
- SET APCLX=$ORDER(^XTMP("APCLOS",APCLJOB,APCLBTH,APCL1,APCLX))
- IF APCLX=""
- QUIT
- SET APCLLC=APCLLC+1
- SET APCLTOTC=^XTMP("APCLOS",APCLJOB,APCLBTH,APCL1,APCLX)+APCLTOTC
- +2 SET APCLX=0
- FOR
- SET APCLX=$ORDER(^XTMP("APCLOSP",APCLJOB,APCLBTH,APCL1,APCLX))
- IF APCLX=""
- QUIT
- SET APCLTOTO=APCLTOTO+^XTMP("APCLOSP",APCLJOB,APCLBTH,APCL1,APCLX)
- +3 QUIT
- PROC ;
- +1 DO GETLINE
- +2 IF $Y>(IOSL-9)
- DO HEAD^APCLOSP
- IF $DATA(APCLQUIT)
- QUIT
- +3 WRITE !!?10,APCLT
- +4 SET APCLN=0
- FOR
- SET APCLN=$ORDER(^XTMP("APCLOS",APCLJOB,APCLBTH,APCL2,APCLN))
- IF APCLN=""!($DATA(APCLQUIT))
- QUIT
- DO PROC1
- +5 IF APCLTOT=1
- DO TOTAL
- +6 QUIT
- PROC1 ;
- +1 SET APCLD=0
- FOR
- SET APCLD=$ORDER(^XTMP("APCLOS",APCLJOB,APCLBTH,APCL2,APCLN,APCLD))
- IF APCLD=""
- QUIT
- DO PRNT
- +2 QUIT
- PRNT ;
- +1 IF $Y>(IOSL-5)
- DO HEAD^APCLOSP
- IF $DATA(APCLQUIT)
- QUIT
- WRITE !?10,APCLT
- IF APCLWC>0
- WRITE " (cont.)"
- +2 SET X=^XTMP("APCLOS",APCLJOB,APCLBTH,APCL2,APCLN,APCLD)
- SET Y=$SELECT($DATA(^XTMP("APCLOSP",APCLJOB,APCLBTH,APCL1,APCLD)):^(APCLD),1:0)
- DO CALC^APCLOSUT
- +3 IF APCLPTR=1
- DO PRNTPTR
- QUIT
- +4 WRITE !?13,APCLD,?45,$JUSTIFY(X,7),?55,"(",Z,")"
- SET APCLWC=APCLWC+1
- +5 QUIT
- PRNTPTR ;
- +1 SET G=APCLGLOB_APCLD_")"
- +2 WRITE !?13,$PIECE(@G@(0),U,APCLPIEC),?45,$JUSTIFY(X,7),?55,"(",Z,")"
- SET APCLWC=APCLWC+1
- +3 QUIT
- TOTAL ;
- +1 SET X=APCLTOTC
- SET Y=APCLTOTO
- DO CALC^APCLOSUT
- +2 WRITE !?15,"TOTAL:",?45,$JUSTIFY(APCLTOTC,8),?55,"(",Z,")"
- +3 QUIT
