- 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
