DGAINP4 ;ALB/RMO - Print Inpatient AMIS's 334-341 ; 27 DEC 89 1:37 pm
;;5.3;Registration;;Aug 13, 1993
;==============================================================
;Print inpatient AMIS segment fields for each division.
;
;Input:
; DGMYR -Month/Year being printed in internal date format
; ^UTILITY-Contains stats by Month/Year, Segment and Division
;==============================================================
S DGPGE=0,DGLNE="",DGIOM=$S('IOM:80,1:IOM),$P(DGLNE,"=",(DGIOM-1))="",DGX="",DGMAR=DGIOM-38
F DGSEG=0:0 S DGSEG=$O(^UTILITY($J,"DGAINP",DGMYR,DGSEG)) Q:'DGSEG!(DGX["^") D SET,PRT
;
Q K DGDIVNB,DGFLD,DGIOM,DGLNE,DGMAR,DGPGE,DGSEG,DGTAB,DGX,I,X,Y
Q
;
SET ;Set Tab Variable for Print
S DGDIVNB=0 F I=0:0 S I=$O(^UTILITY($J,"DGAINP",DGMYR,DGSEG,I)) Q:'I S DGDIVNB=DGDIVNB+1
S DGTAB=$S(DGMAR\DGDIVNB>20:20,1:DGMAR\DGDIVNB)
Q
;
PRT ;Print AMIS Segment
D HD Q:DGX["^"
S DGFLD="001^TOTAL ADMISSIONS" D FLD Q:DGX["^"
S DGFLD="002^TRANSFERS IN" D FLD Q:DGX["^"
S DGFLD="003^CHANGES IN BEDSECTION(+)" D FLD Q:DGX["^"
S DGFLD="004^DEATHS,BO AND ABO" D FLD Q:DGX["^"
S DGFLD="005^DISCHARGE TO OPT/NSC" D FLD Q:DGX["^"
S DGFLD="006^DISCHARGES NOT TO OPT/NSC" D FLD Q:DGX["^"
S DGFLD="007^TRANSFERS OUT" D FLD Q:DGX["^"
S DGFLD="008^CHANGES IN BEDSECTION(-)" D FLD Q:DGX["^"
S DGFLD="009^BED OCCUPANTS EOM" D FLD Q:DGX["^"
S DGFLD="010^ABSENT BED OCCUPANTS EOM" D FLD Q:DGX["^"
S DGFLD="011^PATIENT DAYS OF CARE"_$S(DGSEG=334:" (1-45)",1:"") D FLD Q:DGX["^"
I DGSEG=334 S DGFLD="012^PATIENT DAYS OF CARE ( >45)" D FLD Q:DGX["^"
S DGFLD=$S(DGSEG>334:"012",1:"013")_"^DAYS OF AUTH ABSENCE <96HRS" D FLD Q:DGX["^"
S DGFLD=$S(DGSEG>334:"013",1:"014")_"^OPERATING BEDS EOM" D FLD Q:DGX["^"
S DGFLD=$S(DGSEG>334:"014",1:"015")_"^FEMALE PATIENTS REMAINING EOM" D FLD Q:DGX["^"
I DGSEG=336 S DGFLD="015^DIALYSIS OPERATING BEDS" D FLD Q:DGX["^"
D LEG
Q
;
FLD ;Print Field for AMIS Segment
D HD:($Y+7)>IOSL Q:DGX["^" W !,"(",$P(DGFLD,"^"),") ",$P(DGFLD,"^",2),?38
F I=0:0 S I=$O(^UTILITY($J,"DGAINP",DGMYR,DGSEG,I)) Q:'I W $J(+$P(^(I),"^",+DGFLD),DGTAB-2)
Q
;
HD D CRCHK Q:DGX["^" W @IOF,!?30,"AMIS ",DGSEG," REPORT" S DGPGE=DGPGE+1 S Y=DT X ^DD("DD") W ?60,"DATE: ",Y
W !?30,$S(DGSEG=334:"PSYCHIATRY",DGSEG=335:"INTERMEDIATE MEDICINE",DGSEG=336:"MEDICINE",DGSEG=337:"NEUROLOGY",DGSEG=338:"REHABILITATION MED",DGSEG=339:"BLIND REHABILITATION",DGSEG=340:"SPINAL CORD INJURY",DGSEG=341:"SURGERY",1:"UNKNOWN")
S Y=DGMYR X ^DD("DD") W !?32,"for ",Y
W !!?38 F I=0:0 S I=$O(^UTILITY($J,"DGAINP",DGMYR,DGSEG,I)) Q:'I W $J($E($S($D(^DG(40.8,I,0)):$P(^(0),"^"),1:"UNKNOWN"),1,DGTAB-2),DGTAB)
W !,DGLNE
Q
;
LEG D CRCHK:($Y+7)>IOSL Q:DGX["^" W !,DGLNE,!,"FOR THIS SEGMENT FIELDS SHOULD BALANCE AS FOLLOWS:"
W !!,?3,"Fields 009 and 010 prior period plus 001,002,003 current period"
W !,?3,"less fields 004 thru 008 current period must equal fields",!?3,"009 and 010 current period."
I $D(^DGAM(334,DGMYR,"SE",DGSEG,0)),'$P(^(0),"^",2) W !!,"*** This segment ",$S($P(^(0),"^",2)="":"has Not been Balanced",1:"is Out of Balance"),". ***"
W !,DGLNE
Q
;
CRCHK I DGPGE,$E(IOST,1)="C" W !!,*7,"Press RETURN to continue or '^' to stop " R X:DTIME S:'$T X="^" S DGX=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGAINP4 3268 printed Nov 22, 2024@17:51:22 Page 2
DGAINP4 ;ALB/RMO - Print Inpatient AMIS's 334-341 ; 27 DEC 89 1:37 pm
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;==============================================================
+3 ;Print inpatient AMIS segment fields for each division.
+4 ;
+5 ;Input:
+6 ; DGMYR -Month/Year being printed in internal date format
+7 ; ^UTILITY-Contains stats by Month/Year, Segment and Division
+8 ;==============================================================
+9 SET DGPGE=0
SET DGLNE=""
SET DGIOM=$SELECT('IOM:80,1:IOM)
SET $PIECE(DGLNE,"=",(DGIOM-1))=""
SET DGX=""
SET DGMAR=DGIOM-38
+10 FOR DGSEG=0:0
SET DGSEG=$ORDER(^UTILITY($JOB,"DGAINP",DGMYR,DGSEG))
if 'DGSEG!(DGX["^")
QUIT
DO SET
DO PRT
+11 ;
Q KILL DGDIVNB,DGFLD,DGIOM,DGLNE,DGMAR,DGPGE,DGSEG,DGTAB,DGX,I,X,Y
+1 QUIT
+2 ;
SET ;Set Tab Variable for Print
+1 SET DGDIVNB=0
FOR I=0:0
SET I=$ORDER(^UTILITY($JOB,"DGAINP",DGMYR,DGSEG,I))
if 'I
QUIT
SET DGDIVNB=DGDIVNB+1
+2 SET DGTAB=$SELECT(DGMAR\DGDIVNB>20:20,1:DGMAR\DGDIVNB)
+3 QUIT
+4 ;
PRT ;Print AMIS Segment
+1 DO HD
if DGX["^"
QUIT
+2 SET DGFLD="001^TOTAL ADMISSIONS"
DO FLD
if DGX["^"
QUIT
+3 SET DGFLD="002^TRANSFERS IN"
DO FLD
if DGX["^"
QUIT
+4 SET DGFLD="003^CHANGES IN BEDSECTION(+)"
DO FLD
if DGX["^"
QUIT
+5 SET DGFLD="004^DEATHS,BO AND ABO"
DO FLD
if DGX["^"
QUIT
+6 SET DGFLD="005^DISCHARGE TO OPT/NSC"
DO FLD
if DGX["^"
QUIT
+7 SET DGFLD="006^DISCHARGES NOT TO OPT/NSC"
DO FLD
if DGX["^"
QUIT
+8 SET DGFLD="007^TRANSFERS OUT"
DO FLD
if DGX["^"
QUIT
+9 SET DGFLD="008^CHANGES IN BEDSECTION(-)"
DO FLD
if DGX["^"
QUIT
+10 SET DGFLD="009^BED OCCUPANTS EOM"
DO FLD
if DGX["^"
QUIT
+11 SET DGFLD="010^ABSENT BED OCCUPANTS EOM"
DO FLD
if DGX["^"
QUIT
+12 SET DGFLD="011^PATIENT DAYS OF CARE"_$SELECT(DGSEG=334:" (1-45)",1:"")
DO FLD
if DGX["^"
QUIT
+13 IF DGSEG=334
SET DGFLD="012^PATIENT DAYS OF CARE ( >45)"
DO FLD
if DGX["^"
QUIT
+14 SET DGFLD=$SELECT(DGSEG>334:"012",1:"013")_"^DAYS OF AUTH ABSENCE <96HRS"
DO FLD
if DGX["^"
QUIT
+15 SET DGFLD=$SELECT(DGSEG>334:"013",1:"014")_"^OPERATING BEDS EOM"
DO FLD
if DGX["^"
QUIT
+16 SET DGFLD=$SELECT(DGSEG>334:"014",1:"015")_"^FEMALE PATIENTS REMAINING EOM"
DO FLD
if DGX["^"
QUIT
+17 IF DGSEG=336
SET DGFLD="015^DIALYSIS OPERATING BEDS"
DO FLD
if DGX["^"
QUIT
+18 DO LEG
+19 QUIT
+20 ;
FLD ;Print Field for AMIS Segment
+1 if ($Y+7)>IOSL
DO HD
if DGX["^"
QUIT
WRITE !,"(",$PIECE(DGFLD,"^"),") ",$PIECE(DGFLD,"^",2),?38
+2 FOR I=0:0
SET I=$ORDER(^UTILITY($JOB,"DGAINP",DGMYR,DGSEG,I))
if 'I
QUIT
WRITE $JUSTIFY(+$PIECE(^(I),"^",+DGFLD),DGTAB-2)
+3 QUIT
+4 ;
HD DO CRCHK
if DGX["^"
QUIT
WRITE @IOF,!?30,"AMIS ",DGSEG," REPORT"
SET DGPGE=DGPGE+1
SET Y=DT
XECUTE ^DD("DD")
WRITE ?60,"DATE: ",Y
+1 WRITE !?30,$SELECT(DGSEG=334:"PSYCHIATRY",DGSEG=335:"INTERMEDIATE MEDICINE",DGSEG=336:"MEDICINE",DGSEG=337:"NEUROLOGY",DGSEG=338:"REHABILITATION MED",DGSEG=339:"BLIND REHABILITATION",DGSEG=340:"SPINAL CORD INJURY",DGSEG=341:"SURGERY",1:"UNKNOWN
")
+2 SET Y=DGMYR
XECUTE ^DD("DD")
WRITE !?32,"for ",Y
+3 WRITE !!?38
FOR I=0:0
SET I=$ORDER(^UTILITY($JOB,"DGAINP",DGMYR,DGSEG,I))
if 'I
QUIT
WRITE $JUSTIFY($EXTRACT($SELECT($DATA(^DG(40.8,I,0)):$PIECE(^(0),"^"),1:"UNKNOWN"),1,DGTAB-2),DGTAB)
+4 WRITE !,DGLNE
+5 QUIT
+6 ;
LEG if ($Y+7)>IOSL
DO CRCHK
if DGX["^"
QUIT
WRITE !,DGLNE,!,"FOR THIS SEGMENT FIELDS SHOULD BALANCE AS FOLLOWS:"
+1 WRITE !!,?3,"Fields 009 and 010 prior period plus 001,002,003 current period"
+2 WRITE !,?3,"less fields 004 thru 008 current period must equal fields",!?3,"009 and 010 current period."
+3 IF $DATA(^DGAM(334,DGMYR,"SE",DGSEG,0))
IF '$PIECE(^(0),"^",2)
WRITE !!,"*** This segment ",$SELECT($PIECE(^(0),"^",2)="":"has Not been Balanced",1:"is Out of Balance"),". ***"
+4 WRITE !,DGLNE
+5 QUIT
+6 ;
CRCHK IF DGPGE
IF $EXTRACT(IOST,1)="C"
WRITE !!,*7,"Press RETURN to continue or '^' to stop "
READ X:DTIME
if '$TEST
SET X="^"
SET DGX=X
+1 QUIT
