- APCL1HP ; IHS/CMI/LAB - print report 2A ;
- ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- START ;
- S APCLDT=$$FMTE^XLFDT(DT)
- S APCL132="__________________________________________________________________________________________________________________________________"
- S APCLMOL="OCT.,NOV.,DEC.,JAN.,FEB.,MAR.,APR.,MAY ,JUNE,JULY,AUG.,SEPT"
- S Y=$E(APCLFYE,1,3)_"0000" D DD^%DT S APCLFYD=Y S Y=DT D DD^%DT S APCLDT=Y
- I '$D(^AUTTAREA(APCLAREA,0)) S (APCLAREA,APCLAREC)="???" G START2
- S APCLAREC=$P(^AUTTAREA(APCLAREA,0),U,2),APCLAREA=$P(^AUTTAREA(APCLAREA,0),U)
- START2 S (APCLPG,APCLLOC)=0 D HEAD
- K APCLQUIT
- I APCLGRAN=0 W !!,"NO VISITS FOR THIS FISCAL YEAR",! G DONE
- F S APCLLOC=$O(^XTMP("APCL1H",APCLJOB,APCLBT,"MONLOCTOT",APCLLOC)) Q:APCLLOC=""!($D(APCLQUIT)) D P
- G:$D(APCLQUIT) DONE
- I $Y>(IOSL-8) D HEAD G:$D(APCLQUIT) DONE
- W !!," T O T A L",?29,$J(APCLGRAN,6)
- S APCLMON="",APCLTAB=36 F APCLJ=10,11,12,1,2,3,4,5,6,7,8,9 S APCLMON=$S($D(^XTMP("APCL1H",APCLJOB,APCLBT,"MONTOT",APCLJ)):^(APCLJ),1:0) W ?APCLTAB,$J(APCLMON,6) S APCLTAB=APCLTAB+8
- W !
- DONE ;
- D DONE^APCLOSUT
- K ^XTMP("APCL1H",APCLJOB,APCLBT)
- Q
- P ;
- I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
- S APCLT=^XTMP("APCL1H",APCLJOB,APCLBT,"LOCTOT",APCLLOC)
- S APCLLOCN=$E($P(^DIC(4,APCLLOC,0),U),1,28)
- W !,APCLLOCN,?29,$J(APCLT,6)
- S APCLMON="",APCLTAB=36 F APCLJ=10,11,12,1,2,3,4,5,6,7,8,9 S APCLMON=$S($D(^XTMP("APCL1H",APCLJOB,APCLBT,"MONLOCTOT",APCLLOC,APCLJ)):^(APCLJ),1:0) W ?APCLTAB,$J(APCLMON,6) S APCLTAB=APCLTAB+8 D MONTOT
- Q
- ;
- MONTOT ;set up month totals for all discharges
- S ^(APCLJ)=$S($D(^XTMP("APCL1H",APCLJOB,APCLBT,"MONTOT",APCLJ)):^(APCLJ)+APCLMON,1:APCLMON)
- 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 APCL132,!
- W !?25,"NUMBER OF HOSPITAL DISCHARGES BY MONTH OF DISCHARGE FISCAL YEAR",APCLFYD
- W !,"AREA: ",APCLAREC," ",APCLAREA,?105,APCLDT,?120,"Page ",APCLPG
- W !,APCL132,!
- W !,"HOSPITAL NAME",?30,"YR-TO",!
- W ?30,"DATE"
- S APCLTAB=38 F APCLX=1:1:12 W ?APCLTAB,$P(APCLMOL,",",APCLX) S APCLTAB=APCLTAB+8
- W !,APCL132
- Q
- ;
- APCL1HP ; IHS/CMI/LAB - print report 2A ;
- +1 ;;2.0;IHS PCC SUITE;;MAY 14, 2009
- START ;
- +1 SET APCLDT=$$FMTE^XLFDT(DT)
- +2 SET APCL132="__________________________________________________________________________________________________________________________________"
- +3 SET APCLMOL="OCT.,NOV.,DEC.,JAN.,FEB.,MAR.,APR.,MAY ,JUNE,JULY,AUG.,SEPT"
- +4 SET Y=$EXTRACT(APCLFYE,1,3)_"0000"
- DO DD^%DT
- SET APCLFYD=Y
- SET Y=DT
- DO DD^%DT
- SET APCLDT=Y
- +5 IF '$DATA(^AUTTAREA(APCLAREA,0))
- SET (APCLAREA,APCLAREC)="???"
- GOTO START2
- +6 SET APCLAREC=$PIECE(^AUTTAREA(APCLAREA,0),U,2)
- SET APCLAREA=$PIECE(^AUTTAREA(APCLAREA,0),U)
- START2 SET (APCLPG,APCLLOC)=0
- DO HEAD
- +1 KILL APCLQUIT
- +2 IF APCLGRAN=0
- WRITE !!,"NO VISITS FOR THIS FISCAL YEAR",!
- GOTO DONE
- +3 FOR
- SET APCLLOC=$ORDER(^XTMP("APCL1H",APCLJOB,APCLBT,"MONLOCTOT",APCLLOC))
- IF APCLLOC=""!($DATA(APCLQUIT))
- QUIT
- DO P
- +4 IF $DATA(APCLQUIT)
- GOTO DONE
- +5 IF $Y>(IOSL-8)
- DO HEAD
- IF $DATA(APCLQUIT)
- GOTO DONE
- +6 WRITE !!," T O T A L",?29,$JUSTIFY(APCLGRAN,6)
- +7 SET APCLMON=""
- SET APCLTAB=36
- FOR APCLJ=10,11,12,1,2,3,4,5,6,7,8,9
- SET APCLMON=$SELECT($DATA(^XTMP("APCL1H",APCLJOB,APCLBT,"MONTOT",APCLJ)):^(APCLJ),1:0)
- WRITE ?APCLTAB,$JUSTIFY(APCLMON,6)
- SET APCLTAB=APCLTAB+8
- +8 WRITE !
- DONE ;
- +1 DO DONE^APCLOSUT
- +2 KILL ^XTMP("APCL1H",APCLJOB,APCLBT)
- +3 QUIT
- P ;
- +1 IF $Y>(IOSL-5)
- DO HEAD
- IF $DATA(APCLQUIT)
- QUIT
- +2 SET APCLT=^XTMP("APCL1H",APCLJOB,APCLBT,"LOCTOT",APCLLOC)
- +3 SET APCLLOCN=$EXTRACT($PIECE(^DIC(4,APCLLOC,0),U),1,28)
- +4 WRITE !,APCLLOCN,?29,$JUSTIFY(APCLT,6)
- +5 SET APCLMON=""
- SET APCLTAB=36
- FOR APCLJ=10,11,12,1,2,3,4,5,6,7,8,9
- SET APCLMON=$SELECT($DATA(^XTMP("APCL1H",APCLJOB,APCLBT,"MONLOCTOT",APCLLOC,APCLJ)):^(APCLJ),1:0)
- WRITE ?APCLTAB,$JUSTIFY(APCLMON,6)
- SET APCLTAB=APCLTAB+8
- DO MONTOT
- +6 QUIT
- +7 ;
- MONTOT ;set up month totals for all discharges
- +1 SET ^(APCLJ)=$SELECT($DATA(^XTMP("APCL1H",APCLJOB,APCLBT,"MONTOT",APCLJ)):^(APCLJ)+APCLMON,1:APCLMON)
- +2 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 APCL132,!
- +3 WRITE !?25,"NUMBER OF HOSPITAL DISCHARGES BY MONTH OF DISCHARGE FISCAL YEAR",APCLFYD
- +4 WRITE !,"AREA: ",APCLAREC," ",APCLAREA,?105,APCLDT,?120,"Page ",APCLPG
- +5 WRITE !,APCL132,!
- +6 WRITE !,"HOSPITAL NAME",?30,"YR-TO",!
- +7 WRITE ?30,"DATE"
- +8 SET APCLTAB=38
- FOR APCLX=1:1:12
- WRITE ?APCLTAB,$PIECE(APCLMOL,",",APCLX)
- SET APCLTAB=APCLTAB+8
- +9 WRITE !,APCL132
- +10 QUIT
- +11 ;
