ADGSRVP ; IHS/ADC/PDW/ENM - HSA-202 PRINT ; [ 11/01/2000 1:00 PM ]
;;5.0;ADMISSION/DISCHARGE/TRANSFER;**5,6**;MAR 25, 1999
;
S DGLINE="",$P(DGLINE,"-",80)=""
A ; -- driver
D HD,P1,LS,P2 Q
;
HD N X,Y S X="MONTHLY REPORT OF INPATIENT SERVICES IHS HOSPITALS"
W @IOF W ?80-$L(X)/2,X,!,DGLINE,!,"Name and Location of Hospital"
W ?64,"Month and Year",!!?5,$P($G(^DIC(4,+DUZ(2),0)),U)
S X=$G(^AUTTLOC(+DUZ(2),0))
;IHS/ITSC/ENM 11/01/2000 NEXT LINE COPIED/MOD
;W " ",$P(X,U,13)_", "_$P($G(^DIC(5,+$P(+X,U,14),0)),U)
W " ",$P(X,U,13)_", "_$P($G(^DIC(5,+$P(X,U,14),0)),U)
S Y=$E(DGMON,1,3)+1700,X=$E(DGMON,4,5)
W ?64,$P($P($T(MON),";;",2)," ",X)_" "_Y,!,DGLINE Q
;
P1 S X="Part I - Service and Census" W !?80-$L(X)/2,X,!,DGLINE
W !?31,"Bom",?48,"Discharges",?64,"Eom",?70,"Inpatient"
W !?1,"Medical Services Provided",?30,"Census",?40,"Adm"
W ?48,"Death",?55,"Other",?63,"Census",?72,"Days",!,DGLINE,! Q
;
LS N S,I,J F S=1,2,3,5,6,7 D WS
D TOT Q
;
;IHS/ASDST/LJF/ENM 09/25/00 NEXT 3 LINES DISABLED, 4TH LINE NEW
WS ;I S=1 W:DGA(3,8) ?40,DGA(3,8)_"t" W:DGA(3,7) ?55,DGA(3,7)_"t"
;I S=2 W:DGA(4,8) ?40,DGA(4,8)_"t" W:DGA(4,7) ?54,DGA(4,7)_"t"
;I S=3 W:DGA(3,7) ?40,DGA(3,7)_"t" W:DGA(3,8) ?54,DGA(3,8)_"t"
;IHS/ITSC/ENM 11/01/2000 NEXT LINE COPIED/MOD
;W:DSA(S,7) ?40,DGA(S,7)_"t" W:DGA(S,8) ?54,DGA(S,8)_"t" ;IHS/ANMC/LJF/ENM 09/25/00
W:DGA(S,7) ?40,DGA(S,7)_"t" W:DGA(S,8) ?54,DGA(S,8)_"t" ;IHS/ANMC/LJF/ENM 09/25/00
W !,$P($T(SRV+S),";;",2)
W ?32,$J(DGA(S,1),3),?40,$J(DGA(S,2),3),?48,$J(DGA(S,3),3)
W ?55,$J(DGA(S,4),3),?64,$J(DGA(S,5),3),?72,$J(DGA(S,6),4),! Q
;
TOT ; -- totals
W ?30,"-----",?38,"-----",?46,"-----",?53,"-----",?62,"-----"
W ?70,"------" F I=1:1:6 S DGX(I)=0
F I=1,2,3,5,6,7 F J=1:1:6 S DGX(J)=DGX(J)+DGA(I,J) ;totals
W !?10,"TOTAL",?32,$J(DGX(1),3),?40,$J(DGX(2),3),?48,$J(DGX(3),3)
W ?55,$J(DGX(4),3),?64,$J(DGX(5),3),?72,$J(DGX(6),4),!,DGLINE
; -- newborn
W ! W:DGA(4,7) ?40,DGA(4,7)_"t" W:DGA(4,8) ?54,DGA(4,8)_"t"
W !,"NEWBORN"
W ?32,$J(DGA(4,1),3),?40,$J(DGA(4,2),3),?48,$J(DGA(4,3),3)
W ?55,$J(DGA(4,4),3),?64,$J(DGA(4,5),3),?72,$J(DGA(4,6),4),!,DGLINE
Q
;
P2 W !?26,"Part II - Special Information",!,DGLINE
W !!,"Peak Census, Excluding Newborn................................."
W ?64,DGMAX
W !!,"Minimum Census, Excluding Newborn..............................."
W ?64,DGMIN Q
;
MON ;;JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC
SRV ;;
;;MEDICAL & SURGICAL (Adult)
;;MEDICAL & SURGICAL (Ped.)
;;OBSTETRIC
;;NEWBORN
;;TUBERCULOSIS
;;ALCOHOLISM/SUBSTANCE ABUSE
;;MENTAL HEALTH
ADGSRVP ; IHS/ADC/PDW/ENM - HSA-202 PRINT ; [ 11/01/2000 1:00 PM ]
+1 ;;5.0;ADMISSION/DISCHARGE/TRANSFER;**5,6**;MAR 25, 1999
+2 ;
+3 SET DGLINE=""
SET $PIECE(DGLINE,"-",80)=""
A ; -- driver
+1 DO HD
DO P1
DO LS
DO P2
QUIT
+2 ;
HD NEW X,Y
SET X="MONTHLY REPORT OF INPATIENT SERVICES IHS HOSPITALS"
+1 WRITE @IOF
WRITE ?80-$LENGTH(X)/2,X,!,DGLINE,!,"Name and Location of Hospital"
+2 WRITE ?64,"Month and Year",!!?5,$PIECE($GET(^DIC(4,+DUZ(2),0)),U)
+3 SET X=$GET(^AUTTLOC(+DUZ(2),0))
+4 ;IHS/ITSC/ENM 11/01/2000 NEXT LINE COPIED/MOD
+5 ;W " ",$P(X,U,13)_", "_$P($G(^DIC(5,+$P(+X,U,14),0)),U)
+6 WRITE " ",$PIECE(X,U,13)_", "_$PIECE($GET(^DIC(5,+$PIECE(X,U,14),0)),U)
+7 SET Y=$EXTRACT(DGMON,1,3)+1700
SET X=$EXTRACT(DGMON,4,5)
+8 WRITE ?64,$PIECE($PIECE($TEXT(MON),";;",2)," ",X)_" "_Y,!,DGLINE
QUIT
+9 ;
P1 SET X="Part I - Service and Census"
WRITE !?80-$LENGTH(X)/2,X,!,DGLINE
+1 WRITE !?31,"Bom",?48,"Discharges",?64,"Eom",?70,"Inpatient"
+2 WRITE !?1,"Medical Services Provided",?30,"Census",?40,"Adm"
+3 WRITE ?48,"Death",?55,"Other",?63,"Census",?72,"Days",!,DGLINE,!
QUIT
+4 ;
LS NEW S,I,J
FOR S=1,2,3,5,6,7
DO WS
+1 DO TOT
QUIT
+2 ;
+3 ;IHS/ASDST/LJF/ENM 09/25/00 NEXT 3 LINES DISABLED, 4TH LINE NEW
WS ;I S=1 W:DGA(3,8) ?40,DGA(3,8)_"t" W:DGA(3,7) ?55,DGA(3,7)_"t"
+1 ;I S=2 W:DGA(4,8) ?40,DGA(4,8)_"t" W:DGA(4,7) ?54,DGA(4,7)_"t"
+2 ;I S=3 W:DGA(3,7) ?40,DGA(3,7)_"t" W:DGA(3,8) ?54,DGA(3,8)_"t"
+3 ;IHS/ITSC/ENM 11/01/2000 NEXT LINE COPIED/MOD
+4 ;W:DSA(S,7) ?40,DGA(S,7)_"t" W:DGA(S,8) ?54,DGA(S,8)_"t" ;IHS/ANMC/LJF/ENM 09/25/00
+5 ;IHS/ANMC/LJF/ENM 09/25/00
IF DGA(S,7)
WRITE ?40,DGA(S,7)_"t"
IF DGA(S,8)
WRITE ?54,DGA(S,8)_"t"
+6 WRITE !,$PIECE($TEXT(SRV+S),";;",2)
+7 WRITE ?32,$JUSTIFY(DGA(S,1),3),?40,$JUSTIFY(DGA(S,2),3),?48,$JUSTIFY(DGA(S,3),3)
+8 WRITE ?55,$JUSTIFY(DGA(S,4),3),?64,$JUSTIFY(DGA(S,5),3),?72,$JUSTIFY(DGA(S,6),4),!
QUIT
+9 ;
TOT ; -- totals
+1 WRITE ?30,"-----",?38,"-----",?46,"-----",?53,"-----",?62,"-----"
+2 WRITE ?70,"------"
FOR I=1:1:6
SET DGX(I)=0
+3 ;totals
FOR I=1,2,3,5,6,7
FOR J=1:1:6
SET DGX(J)=DGX(J)+DGA(I,J)
+4 WRITE !?10,"TOTAL",?32,$JUSTIFY(DGX(1),3),?40,$JUSTIFY(DGX(2),3),?48,$JUSTIFY(DGX(3),3)
+5 WRITE ?55,$JUSTIFY(DGX(4),3),?64,$JUSTIFY(DGX(5),3),?72,$JUSTIFY(DGX(6),4),!,DGLINE
+6 ; -- newborn
+7 WRITE !
IF DGA(4,7)
WRITE ?40,DGA(4,7)_"t"
IF DGA(4,8)
WRITE ?54,DGA(4,8)_"t"
+8 WRITE !,"NEWBORN"
+9 WRITE ?32,$JUSTIFY(DGA(4,1),3),?40,$JUSTIFY(DGA(4,2),3),?48,$JUSTIFY(DGA(4,3),3)
+10 WRITE ?55,$JUSTIFY(DGA(4,4),3),?64,$JUSTIFY(DGA(4,5),3),?72,$JUSTIFY(DGA(4,6),4),!,DGLINE
+11 QUIT
+12 ;
P2 WRITE !?26,"Part II - Special Information",!,DGLINE
+1 WRITE !!,"Peak Census, Excluding Newborn................................."
+2 WRITE ?64,DGMAX
+3 WRITE !!,"Minimum Census, Excluding Newborn..............................."
+4 WRITE ?64,DGMIN
QUIT
+5 ;
MON ;;JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC
SRV ;;
+1 ;;MEDICAL & SURGICAL (Adult)
+2 ;;MEDICAL & SURGICAL (Ped.)
+3 ;;OBSTETRIC
+4 ;;NEWBORN
+5 ;;TUBERCULOSIS
+6 ;;ALCOHOLISM/SUBSTANCE ABUSE
+7 ;;MENTAL HEALTH
