- DGANHD1 ;ALB/RMO - Calculate NHCU and DOM AMIS's 345-346 ; 29 AUG 90 10:40 am
- ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- ;==============================================================
- ;NHCU and DOM 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(345,DGMYR,"SE")) F DGSEG=0:0 S DGSEG=$O(^DGAM(345,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 ^DGANHD2,^DGANHD4
- ;
- Q K DGAA,DGABO,DGADE,DGADI,DGAM,DGAO,DGAR,DGAS,DGBO,DGCE0,DGCE1,DGCP0,DGDE,DGDI,DGDIV,DGEND,DGFA,DGFE,DGERRFLG,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(345,"_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="NH":345,X="D":346,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 DGAR=$P(DGCE0,"^",18)-$P(DGCP0,"^",18) ; Adm Reh >30
- S DGAO=($P(DGCE0,"^",17)-$P(DGCP0,"^",17))-DGAR ; Adm All Oth
- S DGTI=$P(DGCE0,"^",13)-$P(DGCP0,"^",13) ; Trf In
- S DGAO=DGAO-DGTI
- S DGFA=$P(DGCE0,"^",19)-$P(DGCP0,"^",19) ; From ASIH
- S DGTO=$P(DGCE0,"^",14)-$P(DGCP0,"^",14) ; Trf Out
- S DGDE=$P(DGCE0,"^",15)-$P(DGCP0,"^",15) ; Deaths
- S DGDI=($P(DGCE0,"^",5)-$P(DGCP0,"^",5))-DGDE-DGTO ; Discharges
- S DGTA=$P(DGCE0,"^",20)-$P(DGCP0,"^",20) ; To ASIH
- S DGBO=$P(DGCE0,"^",2) ; BO Rem EOM
- S DGABO=$P(DGCE1,"^",6)+$P(DGCE1,"^",7) ; ABO Rem EOM
- S DGAS=$P(DGCE1,"^",8) ; ASIH Rem EOM
- S DGFE=$P(DGCE1,"^") ; Fem Rem EOM
- S DGADI=$P(DGCE0,"^",21)-$P(DGCP0,"^",21) ; ASIH Dis
- S DGADE=$P(DGCE0,"^",22)-$P(DGCP0,"^",22) ; ASIH Deaths
- S DGDI=DGDI-DGADI-DGADE
- 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
- Q
- ;
- UTL ;Save AMIS Statistics in the Utility Global
- S DGAM=$S($D(^UTILITY($J,"DGANHD",DGMYR,DGSEG,DGDIV)):^(DGDIV),1:"")
- S DGSTR=DGAR_"^"_DGAO_"^"_DGTI_"^"_DGFA_"^"_DGDI_"^"_DGDE_"^"_DGTO_"^"_DGTA_"^"_DGBO_"^"_DGABO_"^"_DGAS_"^"_DGFE_"^"_DGADI_"^"_DGADE_"^"_DGPD_"^"_DGAA_"^"_DGOB
- S DGEND=17 F I=1:1:DGEND S $P(DGAM,"^",I)=$P(DGAM,"^",I)+$P(DGSTR,"^",I)
- S ^UTILITY($J,"DGANHD",DGMYR,DGSEG,DGDIV)=DGAM
- Q
- DGANHD1 ;ALB/RMO - Calculate NHCU and DOM AMIS's 345-346 ; 29 AUG 90 10:40 am
- +1 ;;5.3;Registration;**1015**;Aug 13, 1993;Build 21
- +2 ;==============================================================
- +3 ;NHCU and DOM 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(345,DGMYR,"SE"))
- FOR DGSEG=0:0
- SET DGSEG=$ORDER(^DGAM(345,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 ^DGANHD2
- DO ^DGANHD4
- +14 ;
- Q KILL DGAA,DGABO,DGADE,DGADI,DGAM,DGAO,DGAR,DGAS,DGBO,DGCE0,DGCE1,DGCP0,DGDE,DGDI,DGDIV,DGEND,DGFA,DGFE,DGERRFLG,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(345,"_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="NH":345,X="D":346,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 ; Adm Reh >30
- SET DGAR=$PIECE(DGCE0,"^",18)-$PIECE(DGCP0,"^",18)
- +2 ; Adm All Oth
- SET DGAO=($PIECE(DGCE0,"^",17)-$PIECE(DGCP0,"^",17))-DGAR
- +3 ; Trf In
- SET DGTI=$PIECE(DGCE0,"^",13)-$PIECE(DGCP0,"^",13)
- +4 SET DGAO=DGAO-DGTI
- +5 ; From ASIH
- SET DGFA=$PIECE(DGCE0,"^",19)-$PIECE(DGCP0,"^",19)
- +6 ; Trf Out
- SET DGTO=$PIECE(DGCE0,"^",14)-$PIECE(DGCP0,"^",14)
- +7 ; Deaths
- SET DGDE=$PIECE(DGCE0,"^",15)-$PIECE(DGCP0,"^",15)
- +8 ; Discharges
- SET DGDI=($PIECE(DGCE0,"^",5)-$PIECE(DGCP0,"^",5))-DGDE-DGTO
- +9 ; To ASIH
- SET DGTA=$PIECE(DGCE0,"^",20)-$PIECE(DGCP0,"^",20)
- +10 ; BO Rem EOM
- SET DGBO=$PIECE(DGCE0,"^",2)
- +11 ; ABO Rem EOM
- SET DGABO=$PIECE(DGCE1,"^",6)+$PIECE(DGCE1,"^",7)
- +12 ; ASIH Rem EOM
- SET DGAS=$PIECE(DGCE1,"^",8)
- +13 ; Fem Rem EOM
- SET DGFE=$PIECE(DGCE1,"^")
- +14 ; ASIH Dis
- SET DGADI=$PIECE(DGCE0,"^",21)-$PIECE(DGCP0,"^",21)
- +15 ; ASIH Deaths
- SET DGADE=$PIECE(DGCE0,"^",22)-$PIECE(DGCP0,"^",22)
- +16 SET DGDI=DGDI-DGADI-DGADE
- +17 ; Pat Day Care
- SET DGPD=$PIECE(DGCE0,"^",3)-$PIECE(DGCP0,"^",3)
- +18 ; AA <96 Hrs
- SET DGAA=$PIECE(DGCE0,"^",9)-$PIECE(DGCP0,"^",9)
- +19 ; Op Bed EOM
- SET DGOB=$PIECE(DGCE1,"^",2)
- +20 QUIT
- +21 ;
- UTL ;Save AMIS Statistics in the Utility Global
- +1 SET DGAM=$SELECT($DATA(^UTILITY($JOB,"DGANHD",DGMYR,DGSEG,DGDIV)):^(DGDIV),1:"")
- +2 SET DGSTR=DGAR_"^"_DGAO_"^"_DGTI_"^"_DGFA_"^"_DGDI_"^"_DGDE_"^"_DGTO_"^"_DGTA_"^"_DGBO_"^"_DGABO_"^"_DGAS_"^"_DGFE_"^"_DGADI_"^"_DGADE_"^"_DGPD_"^"_DGAA_"^"_DGOB
- +3 SET DGEND=17
- FOR I=1:1:DGEND
- SET $PIECE(DGAM,"^",I)=$PIECE(DGAM,"^",I)+$PIECE(DGSTR,"^",I)
- +4 SET ^UTILITY($JOB,"DGANHD",DGMYR,DGSEG,DGDIV)=DGAM
- +5 QUIT
