- DGPMTSO3 ;ALB/LM - TREATING SPECIALTY INPATIENT COUNTS BY TS ;2-2-93
- ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- ;
- START Q:'PTCTS
- S REPORT="< < PATIENT COUNT BY TREATING SPECIALTY > >"
- S (PAGE,TOTAL)=0
- D HEAD^DGPMTSO
- D SUBHEAD
- ;
- DIV S DIV="" F DIV1=0:0 S DIV=$O(^TMP($J,"PTCTS",DIV)) Q:DIV="" D:$Y+8>IOSL HEAD^DGPMTSO,SUBHEAD Q:END W !?5,"DIVISION: ",$S($D(^DG(40.8,DIV,0)):$P(^(0),"^"),1:"EMPTY") D TREAT Q:END D SUB Q:END
- ;
- G:END END
- D:$Y+8>IOSL HEAD^DGPMTSO,SUBHEAD Q:END
- W !?63 F L=1:1:(IOM-66) W "-"
- W !!?69,"TOTAL = ",$J($P(TOTAL,"^",1),4),?89,$J($P(TOTAL,"^",2),4),?97,$J($P(TOTAL,"^",3),4),?105,$J($P(TOTAL,"^",4),4),?114,$J($P(TOTAL,"^",5),4),?124,$J($P(TOTAL,"^",6),4)
- S PTCTS=0
- ;
- END K ABBRV,DGTS,DGTS1,DIV,DIV1,I,INFO,L,PAGE,REPORT,SERVICE,SUBCOUNT,TOTAL,TREAT,TREAT1,SV,SV1,PTCTS
- Q
- ;
- TREAT S TREAT="" F TREAT1=0:0 S TREAT=$O(^TMP($J,"PTCTS",DIV,TREAT)) Q:TREAT="" D DGTS Q:END
- Q
- ;
- DGTS S DGTS="" F DGTS1=0:0 S DGTS=$O(^TMP($J,"PTCTS",DIV,TREAT,DGTS)) Q:DGTS="" D SV Q:END
- Q
- ;
- SV S SV="" F SV1=0:0 S SV=$O(^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV)) Q:SV="" D:$Y+8>IOSL HEAD^DGPMTSO,SUBHEAD Q:END D INFO Q:END
- Q
- ;
- INFO S ABBRV=$S($D(^DIC(45.7,DGTS,0)):$P(^DIC(45.7,DGTS,0),"^",3),1:"")
- S INFO=^TMP($J,"PTCTS",DIV,TREAT,DGTS,SV)
- S $P(INFO,"^",6)=$P(INFO,"^")-$P(INFO,"^",3)-$P(INFO,"^",4)-$P(INFO,"^",5) ; Current patient minus absences except Pass equals patient's remaining.
- ;
- I $Y+8>IOSL D HEAD^DGPMTSO,SUBHEAD Q:END
- LINE W !?3,TREAT,?35,ABBRV,?43,$S(SV'=0:SV,1:""),?80,$J($P(INFO,"^",1),4),?89,$J($P(INFO,"^",2),4),?97,$J($P(INFO,"^",3),4),?105,$J($P(INFO,"^",4),4),?114,$J($P(INFO,"^",5),4),?124,$J($P(INFO,"^",6),4)
- Q
- ;
- ;
- SUB D:$Y+6>IOSL HEAD^DGPMTSO Q:END
- S SUBCOUNT=^TMP($J,"PTCTS",DIV)
- S $P(SUBCOUNT,"^",6)=$P(SUBCOUNT,"^")-$P(SUBCOUNT,"^",3)-$P(SUBCOUNT,"^",4)-$P(SUBCOUNT,"^",5) ; Current patient minus absences except Pass equals patient's remaining.
- W !?66 F L=1:1:(IOM-69) W "-"
- W !!?66,"SUBCOUNT = ",$J($P(SUBCOUNT,"^",1),4),?89,$J($P(SUBCOUNT,"^",2),4),?97,$J($P(SUBCOUNT,"^",3),4),?105,$J($P(SUBCOUNT,"^",4),4),?114,$J($P(SUBCOUNT,"^",5),4),?124,$J($P(SUBCOUNT,"^",6),4),!
- ;
- TOTAL S $P(TOTAL,"^",1)=$P(TOTAL,"^",1)+$P(SUBCOUNT,"^",1) ; current patients
- S $P(TOTAL,"^",2)=$P(TOTAL,"^",2)+$P(SUBCOUNT,"^",2) ; pass
- S $P(TOTAL,"^",3)=$P(TOTAL,"^",3)+$P(SUBCOUNT,"^",3) ; aa
- S $P(TOTAL,"^",4)=$P(TOTAL,"^",4)+$P(SUBCOUNT,"^",4) ; ua
- S $P(TOTAL,"^",5)=$P(TOTAL,"^",5)+$P(SUBCOUNT,"^",5) ; asih
- S $P(TOTAL,"^",6)=$P(TOTAL,"^")-$P(TOTAL,"^",3)-$P(TOTAL,"^",4)-$P(TOTAL,"^",5) ; Current patient minus absences except Pass equals patient's remaining.
- Q
- ;
- SUBHEAD ;
- Q:END
- W !!!,"DIVISION",!?3,"FACILITY TREATING SPECIALTY",?35,"ABBRV",?43,"TREATING SPECIALTY SERVICE",?76,"PATIENTS",?89,"PASS",?99,"AA",?107,"UA",?114,"ASIH",?122,"PTS REM",!
- F L=1:1:(IOM-3) W "-"
- Q
- DGPMTSO3 ;ALB/LM - TREATING SPECIALTY INPATIENT COUNTS BY TS ;2-2-93
- +1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- +2 ;
- START IF 'PTCTS
- QUIT
- +1 SET REPORT="< < PATIENT COUNT BY TREATING SPECIALTY > >"
- +2 SET (PAGE,TOTAL)=0
- +3 DO HEAD^DGPMTSO
- +4 DO SUBHEAD
- +5 ;
- DIV SET DIV=""
- FOR DIV1=0:0
- SET DIV=$ORDER(^TMP($JOB,"PTCTS",DIV))
- IF DIV=""
- QUIT
- IF $Y+8>IOSL
- DO HEAD^DGPMTSO
- DO SUBHEAD
- IF END
- QUIT
- WRITE !?5,"DIVISION: ",$SELECT($DATA(^DG(40.8,DIV,0)):$PIECE(^(0),"^"),1:"EMPTY")
- DO TREAT
- IF END
- QUIT
- DO SUB
- IF END
- QUIT
- +1 ;
- +2 IF END
- GOTO END
- +3 IF $Y+8>IOSL
- DO HEAD^DGPMTSO
- DO SUBHEAD
- IF END
- QUIT
- +4 WRITE !?63
- FOR L=1:1:(IOM-66)
- WRITE "-"
- +5 WRITE !!?69,"TOTAL = ",$JUSTIFY($PIECE(TOTAL,"^",1),4),?89,$JUSTIFY($PIECE(TOTAL,"^",2),4),?97,$JUSTIFY($PIECE(TOTAL,"^",3),4),?105,$JUSTIFY($PIECE(TOTAL,"^",4),4),?114,$JUSTIFY($PIECE(TOTAL,"^",5),4),?124,$JUSTIFY($PIECE(TOTAL,"^",6),4)
- +6 SET PTCTS=0
- +7 ;
- END KILL ABBRV,DGTS,DGTS1,DIV,DIV1,I,INFO,L,PAGE,REPORT,SERVICE,SUBCOUNT,TOTAL,TREAT,TREAT1,SV,SV1,PTCTS
- +1 QUIT
- +2 ;
- TREAT SET TREAT=""
- FOR TREAT1=0:0
- SET TREAT=$ORDER(^TMP($JOB,"PTCTS",DIV,TREAT))
- IF TREAT=""
- QUIT
- DO DGTS
- IF END
- QUIT
- +1 QUIT
- +2 ;
- DGTS SET DGTS=""
- FOR DGTS1=0:0
- SET DGTS=$ORDER(^TMP($JOB,"PTCTS",DIV,TREAT,DGTS))
- IF DGTS=""
- QUIT
- DO SV
- IF END
- QUIT
- +1 QUIT
- +2 ;
- SV SET SV=""
- FOR SV1=0:0
- SET SV=$ORDER(^TMP($JOB,"PTCTS",DIV,TREAT,DGTS,SV))
- IF SV=""
- QUIT
- IF $Y+8>IOSL
- DO HEAD^DGPMTSO
- DO SUBHEAD
- IF END
- QUIT
- DO INFO
- IF END
- QUIT
- +1 QUIT
- +2 ;
- INFO SET ABBRV=$SELECT($DATA(^DIC(45.7,DGTS,0)):$PIECE(^DIC(45.7,DGTS,0),"^",3),1:"")
- +1 SET INFO=^TMP($JOB,"PTCTS",DIV,TREAT,DGTS,SV)
- +2 ; Current patient minus absences except Pass equals patient's remaining.
- SET $PIECE(INFO,"^",6)=$PIECE(INFO,"^")-$PIECE(INFO,"^",3)-$PIECE(INFO,"^",4)-$PIECE(INFO,"^",5)
- +3 ;
- +4 IF $Y+8>IOSL
- DO HEAD^DGPMTSO
- DO SUBHEAD
- IF END
- QUIT
- LINE WRITE !?3,TREAT,?35,ABBRV,?43,$SELECT(SV'=0:SV,1:""),?80,$JUSTIFY($PIECE(INFO,"^",1),4),?89,$JUSTIFY($PIECE(INFO,"^",2),4),?97,$JUSTIFY($PIECE(INFO,"^",3),4),?105,$JUSTIFY($PIECE(INFO,"^",4),4),?114,$JUSTIFY($PIECE(INFO,"^",5),4),?124,...
- ... $JUSTIFY($PIECE(INFO,"^",6),4)
- +1 QUIT
- +2 ;
- +3 ;
- SUB IF $Y+6>IOSL
- DO HEAD^DGPMTSO
- IF END
- QUIT
- +1 SET SUBCOUNT=^TMP($JOB,"PTCTS",DIV)
- +2 ; Current patient minus absences except Pass equals patient's remaining.
- SET $PIECE(SUBCOUNT,"^",6)=$PIECE(SUBCOUNT,"^")-$PIECE(SUBCOUNT,"^",3)-$PIECE(SUBCOUNT,"^",4)-$PIECE(SUBCOUNT,"^",5)
- +3 WRITE !?66
- FOR L=1:1:(IOM-69)
- WRITE "-"
- +4 WRITE !!?66,"SUBCOUNT = ",$JUSTIFY($PIECE(SUBCOUNT,"^",1),4),?89,$JUSTIFY($PIECE(SUBCOUNT,"^",2),4),?97,$JUSTIFY($PIECE(SUBCOUNT,"^",3),4),?105,$JUSTIFY($PIECE(SUBCOUNT,"^",4),4),?114,$JUSTIFY($PIECE(SUBCOUNT,"^",5),4),?124,...
- ... $JUSTIFY($PIECE(SUBCOUNT,"^",6),4),!
- +5 ;
- TOTAL ; current patients
- SET $PIECE(TOTAL,"^",1)=$PIECE(TOTAL,"^",1)+$PIECE(SUBCOUNT,"^",1)
- +1 ; pass
- SET $PIECE(TOTAL,"^",2)=$PIECE(TOTAL,"^",2)+$PIECE(SUBCOUNT,"^",2)
- +2 ; aa
- SET $PIECE(TOTAL,"^",3)=$PIECE(TOTAL,"^",3)+$PIECE(SUBCOUNT,"^",3)
- +3 ; ua
- SET $PIECE(TOTAL,"^",4)=$PIECE(TOTAL,"^",4)+$PIECE(SUBCOUNT,"^",4)
- +4 ; asih
- SET $PIECE(TOTAL,"^",5)=$PIECE(TOTAL,"^",5)+$PIECE(SUBCOUNT,"^",5)
- +5 ; Current patient minus absences except Pass equals patient's remaining.
- SET $PIECE(TOTAL,"^",6)=$PIECE(TOTAL,"^")-$PIECE(TOTAL,"^",3)-$PIECE(TOTAL,"^",4)-$PIECE(TOTAL,"^",5)
- +6 QUIT
- +7 ;
- SUBHEAD ;
- +1 IF END
- QUIT
- +2 WRITE !!!,"DIVISION",!?3,"FACILITY TREATING SPECIALTY",?35,"ABBRV",?43,"TREATING SPECIALTY SERVICE",?76,"PATIENTS",?89,"PASS",?99,"AA",?107,"UA",?114,"ASIH",?122,"PTS REM",!
- +3 FOR L=1:1:(IOM-3)
- WRITE "-"
- +4 QUIT
