DGAINP1 ;ALB/RMO - Calculate Inpatient AMIS's 334-341 ; 27 DEC 89 1:37 pm
;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
;==============================================================
;Inpatient AMIS segments are calculated by looping through the
;Ward Location file.
;
;Input:
; DGMYR -Month/Year being calculated in internal date format
; DGEOM -Last day of Month/Year in internal date format
; DGPEOM -Last day of Prior Month/Year in internal date format
;==============================================================
I $D(^DGAM(334,DGMYR,"SE")) F DGSEG=0:0 S DGSEG=$O(^DGAM(334,DGMYR,"SE",DGSEG)) Q:'DGSEG D DEL
F DGWI=0:0 S DGWI=$O(^DIC(42,DGWI)) Q:'DGWI I $D(^(DGWI,0)) S DGW0=^(0) D CEN I DGSEG,'DGERRFLG D CAL,UTL
D PSY,^DGAINP2,^DGAINP4
;
Q K DGAA,DGAM,DGABO,DGBO,DGCE0,DGCE1,DGCP0,DGDA,DGDE,DGDO,DGDIV,DGEND,DGERRFLG,DGFE,DGGB,DGL45,DGLB,DGOB,DGPD,DGSEG,DGSTR,DGTA,DGTI,DGTO,DGW0,DGWI,I,X
Q
;
DEL ;Delete Previous AMIS Statistics
S DA(1)=DGMYR,DA=DGSEG,DIK="^DGAM(334,"_DGMYR_",""SE""," D ^DIK K DA,DIK
Q
;
CEN ;AMIS Statistics are Calculated using data for Ward from Census File
S DGERRFLG=0,X=$P(DGW0,"^",3),DGSEG=$S(X="P":334,X="I":335,X="M":336,X="NE":337,X="R":338,X="B":339,X="SCI":340,X="S":341,1:0) Q:'DGSEG
S DGDIV=$S($P(DGW0,"^",11):+$P(DGW0,"^",11),$D(^DG(43,1,"GL")):+$P(^("GL"),"^",3),1:0)
S DGCP0=$S($E(DGPEOM,4,5)="09":0,$D(^DG(41.9,DGWI,"C",DGPEOM,0)):^(0),1:"") ;Last day of prior month
S DGCE0=$S($D(^DG(41.9,DGWI,"C",DGEOM,0)):^(0),1:""),DGCE1=$S($D(^DG(41.9,DGWI,"C",DGEOM,1)):^(1),1:"") ;Last day of selected month
I DGCP0=""!(DGCE0="") W !!,$S(DGCP0="":"Beginning",1:"End")," of month statistics are missing for ward ",$P(DGW0,"^"),".",!,"Ward not included in AMIS ",DGSEG," calculations." S DGERRFLG=1
Q
;
CAL ;Actual Calculations for AMIS Fields
S DGTI=$P(DGCE0,"^",13)-$P(DGCP0,"^",13) ; Trf In
S DGTA=($P(DGCE0,"^",17)-$P(DGCP0,"^",17))-DGTI ; Tot Adm
S DGGB=$P(DGCE0,"^",23)-$P(DGCP0,"^",23) ; Gain Bed Sec
S DGDE=$P(DGCE0,"^",15)-$P(DGCP0,"^",15) ; Deaths
S DGDO=($P(DGCE0,"^",16)-$P(DGCP0,"^",16)) ; Dis OPT/NSC
S DGTO=$P(DGCE0,"^",14)-$P(DGCP0,"^",14) ; Trf Out
S DGDA=($P(DGCE0,"^",5)-$P(DGCP0,"^",5))-DGDE-DGDO-DGTO ;Dis All Oth
S DGLB=$P(DGCE0,"^",8)-$P(DGCP0,"^",8) ; Loss Bed Sec
S DGBO=$P(DGCE0,"^",2) ; BO Rem EOM
S DGABO=$P(DGCE1,"^",6)+$P(DGCE1,"^",7) ; ABO Rem EOM
S DGPD=$P(DGCE0,"^",3)-$P(DGCP0,"^",3) ; Pat Day Care
S DGAA=$P(DGCE0,"^",9)-$P(DGCP0,"^",9) ; AA <96 Hrs
S DGOB=$P(DGCE1,"^",2) ; Op Bed EOM
S DGFE=$P(DGCE1,"^") ; Fem Rem EOM
Q
;
UTL ;Save AMIS Statistics in the Utility Global
;Note: Dial Op Beds set to 0 for Austin
S DGAM=$S($D(^UTILITY($J,"DGAINP",DGMYR,DGSEG,DGDIV)):^(DGDIV),1:"")
S DGSTR=DGTA_"^"_DGTI_"^"_DGGB_"^"_DGDE_"^"_DGDO_"^"_DGDA_"^"_DGTO_"^"_DGLB_"^"_DGBO_"^"_DGABO_"^"_$S(DGSEG>334:DGPD,1:"0^"_DGPD)_"^"_DGAA_"^"_DGOB_"^"_DGFE_$S(DGSEG=336:"^0",1:"")
S DGEND=$S(DGSEG=334!(DGSEG=336):15,1:14) F I=1:1:DGEND S $P(DGAM,"^",I)=$P(DGAM,"^",I)+$P(DGSTR,"^",I)
S ^UTILITY($J,"DGAINP",DGMYR,DGSEG,DGDIV)=DGAM
Q
;
PSY ;Set Utility GLobal for Psych 1-45 PDC
D ^DGAINP0
F DGDIV=0:0 S DGDIV=$O(^UTILITY($J,"DGAINP",DGMYR,334,DGDIV)) Q:'DGDIV S:$D(DGL45(DGDIV)) $P(^(DGDIV),"^",11,12)=DGL45(DGDIV)_"^"_$S($P(^(DGDIV),"^",12)<DGL45(DGDIV):0,1:$P(^(DGDIV),"^",12)-DGL45(DGDIV))
Q
DGAINP1 ;ALB/RMO - Calculate Inpatient AMIS's 334-341 ; 27 DEC 89 1:37 pm
+1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
+2 ;==============================================================
+3 ;Inpatient AMIS segments are calculated by looping through the
+4 ;Ward Location file.
+5 ;
+6 ;Input:
+7 ; DGMYR -Month/Year being calculated in internal date format
+8 ; DGEOM -Last day of Month/Year in internal date format
+9 ; DGPEOM -Last day of Prior Month/Year in internal date format
+10 ;==============================================================
+11 IF $DATA(^DGAM(334,DGMYR,"SE"))
FOR DGSEG=0:0
SET DGSEG=$ORDER(^DGAM(334,DGMYR,"SE",DGSEG))
IF 'DGSEG
QUIT
DO DEL
+12 FOR DGWI=0:0
SET DGWI=$ORDER(^DIC(42,DGWI))
IF 'DGWI
QUIT
IF $DATA(^(DGWI,0))
SET DGW0=^(0)
DO CEN
IF DGSEG
IF 'DGERRFLG
DO CAL
DO UTL
+13 DO PSY
DO ^DGAINP2
DO ^DGAINP4
+14 ;
Q KILL DGAA,DGAM,DGABO,DGBO,DGCE0,DGCE1,DGCP0,DGDA,DGDE,DGDO,DGDIV,DGEND,DGERRFLG,DGFE,DGGB,DGL45,DGLB,DGOB,DGPD,DGSEG,DGSTR,DGTA,DGTI,DGTO,DGW0,DGWI,I,X
+1 QUIT
+2 ;
DEL ;Delete Previous AMIS Statistics
+1 SET DA(1)=DGMYR
SET DA=DGSEG
SET DIK="^DGAM(334,"_DGMYR_",""SE"","
DO ^DIK
KILL DA,DIK
+2 QUIT
+3 ;
CEN ;AMIS Statistics are Calculated using data for Ward from Census File
+1 SET DGERRFLG=0
SET X=$PIECE(DGW0,"^",3)
SET DGSEG=$SELECT(X="P":334,X="I":335,X="M":336,X="NE":337,X="R":338,X="B":339,X="SCI":340,X="S":341,1:0)
IF 'DGSEG
QUIT
+2 SET DGDIV=$SELECT($PIECE(DGW0,"^",11):+$PIECE(DGW0,"^",11),$DATA(^DG(43,1,"GL")):+$PIECE(^("GL"),"^",3),1:0)
+3 ;Last day of prior month
SET DGCP0=$SELECT($EXTRACT(DGPEOM,4,5)="09":0,$DATA(^DG(41.9,DGWI,"C",DGPEOM,0)):^(0),1:"")
+4 ;Last day of selected month
SET DGCE0=$SELECT($DATA(^DG(41.9,DGWI,"C",DGEOM,0)):^(0),1:"")
SET DGCE1=$SELECT($DATA(^DG(41.9,DGWI,"C",DGEOM,1)):^(1),1:"")
+5 IF DGCP0=""!(DGCE0="")
WRITE !!,$SELECT(DGCP0="":"Beginning",1:"End")," of month statistics are missing for ward ",$PIECE(DGW0,"^"),".",!,"Ward not included in AMIS ",DGSEG," calculations."
SET DGERRFLG=1
+6 QUIT
+7 ;
CAL ;Actual Calculations for AMIS Fields
+1 ; Trf In
SET DGTI=$PIECE(DGCE0,"^",13)-$PIECE(DGCP0,"^",13)
+2 ; Tot Adm
SET DGTA=($PIECE(DGCE0,"^",17)-$PIECE(DGCP0,"^",17))-DGTI
+3 ; Gain Bed Sec
SET DGGB=$PIECE(DGCE0,"^",23)-$PIECE(DGCP0,"^",23)
+4 ; Deaths
SET DGDE=$PIECE(DGCE0,"^",15)-$PIECE(DGCP0,"^",15)
+5 ; Dis OPT/NSC
SET DGDO=($PIECE(DGCE0,"^",16)-$PIECE(DGCP0,"^",16))
+6 ; Trf Out
SET DGTO=$PIECE(DGCE0,"^",14)-$PIECE(DGCP0,"^",14)
+7 ;Dis All Oth
SET DGDA=($PIECE(DGCE0,"^",5)-$PIECE(DGCP0,"^",5))-DGDE-DGDO-DGTO
+8 ; Loss Bed Sec
SET DGLB=$PIECE(DGCE0,"^",8)-$PIECE(DGCP0,"^",8)
+9 ; BO Rem EOM
SET DGBO=$PIECE(DGCE0,"^",2)
+10 ; ABO Rem EOM
SET DGABO=$PIECE(DGCE1,"^",6)+$PIECE(DGCE1,"^",7)
+11 ; Pat Day Care
SET DGPD=$PIECE(DGCE0,"^",3)-$PIECE(DGCP0,"^",3)
+12 ; AA <96 Hrs
SET DGAA=$PIECE(DGCE0,"^",9)-$PIECE(DGCP0,"^",9)
+13 ; Op Bed EOM
SET DGOB=$PIECE(DGCE1,"^",2)
+14 ; Fem Rem EOM
SET DGFE=$PIECE(DGCE1,"^")
+15 QUIT
+16 ;
UTL ;Save AMIS Statistics in the Utility Global
+1 ;Note: Dial Op Beds set to 0 for Austin
+2 SET DGAM=$SELECT($DATA(^UTILITY($JOB,"DGAINP",DGMYR,DGSEG,DGDIV)):^(DGDIV),1:"")
+3 SET DGSTR=DGTA_"^"_DGTI_"^"_DGGB_"^"_DGDE_"^"_DGDO_"^"_DGDA_"^"_DGTO_"^"_DGLB_"^"_DGBO_"^"_DGABO_"^"_$SELECT(DGSEG>334:DGPD,1:"0^"_DGPD)_"^"_DGAA_"^"_DGOB_"^"_DGFE_$SELECT(DGSEG=336:"^0",1:"")
+4 SET DGEND=$SELECT(DGSEG=334!(DGSEG=336):15,1:14)
FOR I=1:1:DGEND
SET $PIECE(DGAM,"^",I)=$PIECE(DGAM,"^",I)+$PIECE(DGSTR,"^",I)
+5 SET ^UTILITY($JOB,"DGAINP",DGMYR,DGSEG,DGDIV)=DGAM
+6 QUIT
+7 ;
PSY ;Set Utility GLobal for Psych 1-45 PDC
+1 DO ^DGAINP0
+2 FOR DGDIV=0:0
SET DGDIV=$ORDER(^UTILITY($JOB,"DGAINP",DGMYR,334,DGDIV))
IF 'DGDIV
QUIT
IF $DATA(DGL45(DGDIV))
SET $PIECE(^(DGDIV),"^",11,12)=DGL45(DGDIV)_"^"_$SELECT($PIECE(^(DGDIV),"^",12)<DGL45(DGDIV):0,1:$PIECE(^(DGDIV),"^",12)-DGL45(DGDIV))
+3 QUIT
