APCLCVP ; IHS/CMI/LAB - Indian Beneficiary Calendar Year Visit Summary ;
;;2.0;IHS PCC SUITE;;MAY 14, 2009
;IHS/CMI/LAB - reformatted to include a 2nd column
START ;
S APCLBDD=$$FMTE^XLFDT(APCLBD)
S APCL80="_____________________________________________________________________________"
S APCLFAC=""
I $D(DUZ(2)) S:$D(^DIC(4,DUZ(2),0)) APCLFAC=$P(^(0),U)
S APCLPG=0
D HEAD
D P
D DONE
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 ?19,"MONTHLY PROGRESS - VISIT SUMMARY REPORT",!
W ?25,"INDIAN/ALASKA NATIVE VISITS",!
W ?33,$$FMTE^XLFDT(DT),!
W !?5,"FACILITY: ",?20,APCLFAC," ",?67,"Page ",APCLPG
W !?5,"DATE RANGE: ",?20,APCLBDD," TO ",APCLEDD
I APCLLOC'="" S:$D(^DIC(4,APCLLOC,0)) APCLLOCP=$P(^(0),U)
I APCLLOC="" S APCLLOCP="All Locations"
W !?5,"LOCATION: ",?20,APCLLOCP,!
I $D(APCLCLNT) W ?5,"CLINIC(S): " S X=0,C=0 F S X=$O(APCLCLNT(X)) Q:X="" W:C "," W $P(^DIC(40.7,X,0),U,2) S C=C+1
I APCLCL="",'$D(APCLCLNT) W ?5,"CLINIC: All Clinics"
W !,APCL80,!
W !,"Report Dates:",?51,"Non-Indian mem"
W !?5,APCLBDD," to ",APCLEDD,?43,"Indian",?51,"Ind. Household",?68,"All Other"
W !,APCL80
Q
;
DONE ;
;KILL SOME STUFF
D DONE^APCLOSUT
K APCL1,APCL2,APCL3,APCL4,APCL5,APCL1O,APCL2O,APCL3O,APCL4O,APCLG,APCLGO,APCL80
K ^XTMP("APCLCV",APCLJOB)
Q
;
P ;
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
W !!,?1,"Date Range Visit Summary",!!
W ?1,"1. New Patient's First Visit",?39,$J($FN(APCL1,","),10),?52,$J($FN(APCL1N,","),10),?65,$J($FN(APCL1O,","),10),!!
W ?1,"2. Established Patient's First Visit",?39,$J($FN(APCL2,","),10),?52,$J($FN(APCL2N,","),10),?65,$J($FN(APCL2O,","),10),!!
W ?1,"3. Total First Visits (1-2)",?39,$J($FN(APCL3,","),10),?52,$J($FN(APCL3N,","),10),?65,$J($FN(APCL3O,","),10),!!
W ?1,"4. Additional Visits (2nd,3rd,etc.)",?39,$J($FN(APCL4,","),10),?52,$J($FN(APCL4N,","),10),?65,$J($FN(APCL4O,","),10),!
W ?43,"______",?57,"______",?70,"______",!!
S APCLG=APCL1+APCL2+APCL4
S APCLGO=APCL1O+APCL2O+APCL4O
S APCLGN=APCL1N+APCL2N+APCL4N
W ?1,"5. SUB-TOTAL",?39,$J($FN(APCLG,","),10),?52,$J($FN(APCLGN,","),10),?65,$J($FN(APCLGO,","),10),!!
W ?5,"GRAND TOTAL-ALL VISITS: ",?20,$J($FN(APCL5,","),10)
Q
APCLCVP ; IHS/CMI/LAB - Indian Beneficiary Calendar Year Visit Summary ;
+1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
+2 ;IHS/CMI/LAB - reformatted to include a 2nd column
START ;
+1 SET APCLBDD=$$FMTE^XLFDT(APCLBD)
+2 SET APCL80="_____________________________________________________________________________"
+3 SET APCLFAC=""
+4 IF $DATA(DUZ(2))
IF $DATA(^DIC(4,DUZ(2),0))
SET APCLFAC=$PIECE(^(0),U)
+5 SET APCLPG=0
+6 DO HEAD
+7 DO P
+8 DO DONE
+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
+2 SET APCLPG=APCLPG+1
+3 WRITE ?19,"MONTHLY PROGRESS - VISIT SUMMARY REPORT",!
+4 WRITE ?25,"INDIAN/ALASKA NATIVE VISITS",!
+5 WRITE ?33,$$FMTE^XLFDT(DT),!
+6 WRITE !?5,"FACILITY: ",?20,APCLFAC," ",?67,"Page ",APCLPG
+7 WRITE !?5,"DATE RANGE: ",?20,APCLBDD," TO ",APCLEDD
+8 IF APCLLOC'=""
IF $DATA(^DIC(4,APCLLOC,0))
SET APCLLOCP=$PIECE(^(0),U)
+9 IF APCLLOC=""
SET APCLLOCP="All Locations"
+10 WRITE !?5,"LOCATION: ",?20,APCLLOCP,!
+11 IF $DATA(APCLCLNT)
WRITE ?5,"CLINIC(S): "
SET X=0
SET C=0
FOR
SET X=$ORDER(APCLCLNT(X))
IF X=""
QUIT
IF C
WRITE ","
WRITE $PIECE(^DIC(40.7,X,0),U,2)
SET C=C+1
+12 IF APCLCL=""
IF '$DATA(APCLCLNT)
WRITE ?5,"CLINIC: All Clinics"
+13 WRITE !,APCL80,!
+14 WRITE !,"Report Dates:",?51,"Non-Indian mem"
+15 WRITE !?5,APCLBDD," to ",APCLEDD,?43,"Indian",?51,"Ind. Household",?68,"All Other"
+16 WRITE !,APCL80
+17 QUIT
+18 ;
DONE ;
+1 ;KILL SOME STUFF
+2 DO DONE^APCLOSUT
+3 KILL APCL1,APCL2,APCL3,APCL4,APCL5,APCL1O,APCL2O,APCL3O,APCL4O,APCLG,APCLGO,APCL80
+4 KILL ^XTMP("APCLCV",APCLJOB)
+5 QUIT
+6 ;
P ;
+1 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+2 WRITE !!,?1,"Date Range Visit Summary",!!
+3 WRITE ?1,"1. New Patient's First Visit",?39,$JUSTIFY($FNUMBER(APCL1,","),10),?52,$JUSTIFY($FNUMBER(APCL1N,","),10),?65,$JUSTIFY($FNUMBER(APCL1O,","),10),!!
+4 WRITE ?1,"2. Established Patient's First Visit",?39,$JUSTIFY($FNUMBER(APCL2,","),10),?52,$JUSTIFY($FNUMBER(APCL2N,","),10),?65,$JUSTIFY($FNUMBER(APCL2O,","),10),!!
+5 WRITE ?1,"3. Total First Visits (1-2)",?39,$JUSTIFY($FNUMBER(APCL3,","),10),?52,$JUSTIFY($FNUMBER(APCL3N,","),10),?65,$JUSTIFY($FNUMBER(APCL3O,","),10),!!
+6 WRITE ?1,"4. Additional Visits (2nd,3rd,etc.)",?39,$JUSTIFY($FNUMBER(APCL4,","),10),?52,$JUSTIFY($FNUMBER(APCL4N,","),10),?65,$JUSTIFY($FNUMBER(APCL4O,","),10),!
+7 WRITE ?43,"______",?57,"______",?70,"______",!!
+8 SET APCLG=APCL1+APCL2+APCL4
+9 SET APCLGO=APCL1O+APCL2O+APCL4O
+10 SET APCLGN=APCL1N+APCL2N+APCL4N
+11 WRITE ?1,"5. SUB-TOTAL",?39,$JUSTIFY($FNUMBER(APCLG,","),10),?52,$JUSTIFY($FNUMBER(APCLGN,","),10),?65,$JUSTIFY($FNUMBER(APCLGO,","),10),!!
+12 WRITE ?5,"GRAND TOTAL-ALL VISITS: ",?20,$JUSTIFY($FNUMBER(APCL5,","),10)
+13 QUIT
