Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ADGSVP1

ADGSVP1.m

Go to the documentation of this file. 
  1. ADGSVP1 ; IHS/ADC/PDW/ENM - HSA-202 PRINT ; [ 12/08/1999  4:17 PM ]
  1.  ;;5.0;ADMISSION/DISCHARGE/TRANSFER;**2,3**;MAR 25, 1999
  1.  ;
  1.  N ND,LN,X,Y,X1,X2
  1.  S X1=$E(DGEMON,1,5)_$$ND,X2=$E(DGSMON,1,5)_"01" D ^%DTC S ND=X+1
  1.  S LN="",$P(LN,"-",40)=""
  1. P3 W !,DGLINE,!?16,"Part III",!?13,"Beds Available"
  1.  W ?50,"Comments",!,LN,!,"STAFF UNITS",?21,"# of Beds",?32,"% Occup."
  1.  ;W ?45,"ALOS: ",?60,"ADULT: ",$J(DGA(1,9)/DGLOS(1),1,2)    ;adu alos
  1.  W ?45,"ALOS: ",?60,"ADULT: ",$J($$LOS1(),1,2)
  1.  ;W !,LN,?56,"PEDIATRIC: ",$J(DGA(2,9)/DGLOS(2),1,2)        ;ped alos
  1.  W !,LN,?56,"PEDIATRIC: ",$J($$LOS2(),1,2)
  1.  ;W !?58,"NEWBORN: ",$J(DGA(4,9)/DGLOS(4),1,2)             ;nb  alos
  1.  W !?58,"NEWBORN: ",$J($$LOS4(),1,2)
  1.  W !,"MEDICAL (Adult)",?28,DGBED("AM")                     ;# med beds
  1.  W !,"SURGICAL (Adult)",?28,DGBED("AS"),?27,"_____"        ;# sur beds
  1.  W ?45,"ADPL:",?60,"ADULT: ",$J(DGA(1,6)+DGA(3,6)/ND,1,2)  ;adu adpl
  1.  W !?15,"Subtotal",?28,DGBED("AM")+DGBED("AS"),?35,$$OA   ;adu # & %
  1.  W ?56,"PEDIATRIC: ",$J(DGA(2,6)/ND,1,2)                   ;ped adpl
  1.  W !?58,"NEWBORN: ",$J(DGA(4,6)/ND,1,2)                   ;nb  adpl
  1.  W !,"MEDICAL (Pediatric)",?28,DGBED("PM")                 ;# m ped beds
  1.  W !,"SURGICAL (Pediatric)",?28,DGBED("PS"),?27,"_____"    ;# s ped beds
  1.  W ?45,"1 DAY PATIENTS ADULT: ",DGA(1,10)                  ;1day
  1.  W !?15,"Subtotal",?28,DGBED("PM")+DGBED("PS"),?35,$$OP   ;ped # & %
  1.  W ?56,"PEDIATRIC: ",DGA(2,10),!?58,"NEWBORN: ",DGA(4,10) ;1day
  1.  W !,"OBSTETRIC",?28,DGBED("O"),?35,$$OO                   ;ob  # & %
  1.  W !,"TUBERCULOSIS",?28,DGBED("T"),?35,$$OT                ;tb  # & %
  1.  W ?49,"ICU PATIENT DAYS: ",$$ICU
  1.  W !,"ALCOHOL/SUBSTANCE ABUSE",?28,DGBED("AL"),?35,$$OL    ;al  # & %
  1.  W ?49,"PCU PATIENT DAYS: ",$$PCU
  1.  W !,"MENTAL HEALTH",?28,DGBED("MH"),?35,$$OM              ;mh  # & %
  1.  W !,"ICU/SCU",?28,DGBED("I"),?35,$$OI                     ;icu # & %
  1.  W !,"PCU",?28,DGBED("P"),?35,$$OU                         ;pcu # & %
  1.  W ?48,"NON-BENEFICIARIES: ",!?27,"_____",?53,"# Discharged: ",DGCNT
  1.  W !?18,"Total",?28,$$TOT,?48,"With total LOS of ",DGLOS," days"
  1.  W !!,"NEWBORN",?28,DGBED("N"),?35,$$ON                    ;nb  # & %
  1.  W ?51,"% OF OCCUPANCY: ",$$OC,!,DGLINE
  1.  W !,"Name of SUD",?35,"Signature Of SUD",?65,"Date" Q
  1.  ;
  1. DAY ;;31 28 31 30 31 30 31 31 30 31 30 31
  1.  ;
  1. ND() ; -- # days in month
  1.  N X S X=$P($P($T(DAY),";;",2)," ",$E(DGEMON,4,5))
  1.  Q $S(X'=28:X,$E(DGEMON,1,3)#4=0:29,1:X)
  1.  ;
  1. OA() ; -- occup, adult
  1.  Q:'(DGBED("AM")+DGBED("AS")) ""
  1.  Q $E($P(DGA(1,6)/ND/(DGBED("AM")+DGBED("AS")),".",2),1,2)_"%"
  1.  ;
  1. OP() ; -- occup, ped     
  1.  Q:'(DGBED("PM")+DGBED("PS")) ""
  1.  Q $E($P(DGA(2,6)/ND/(DGBED("PM")+DGBED("PS")),".",2),1,2)_"%"
  1.  ;
  1. OO() ; -- occup, ob
  1.  Q:'DGBED("O") "" Q $E($P(DGA(3,6)/ND/DGBED("O"),".",2),1,2)_"%"
  1.  ;
  1. OT() ; -- occup, tb
  1.  Q:'DGBED("T") "" Q $E($P(DGA(5,6)/ND/DGBED("T"),".",2),1,2)_"%"
  1.  ;
  1. OL() ; -- occup, al
  1.  Q:'DGBED("AL") "" Q $E($P(DGA(6,6)/ND/DGBED("AL"),".",2),1,2)_"%"
  1.  ;
  1. OM() ; -- occup, mh
  1.  Q:'DGBED("MH") "" Q $E($P(DGA(7,6)/ND/DGBED("MH"),".",2),1,2)_"%"
  1.  ;
  1. OI() ; -- occup, icu
  1.  Q:'DGBED("I") ""  Q $E($P($$ICU/ND/DGBED("I"),".",2),1,2)_"%"
  1.  ;
  1. OU() ; -- occup, pcu
  1.  Q:'DGBED("P") ""  Q $E($P($$PCU/ND/DGBED("P"),".",2),1,2)_"%"
  1.  ;
  1. ON() ; -- occup, nb
  1.  Q:'DGBED("N") ""  Q $E($P(DGA(4,6)/ND/DGBED("N"),".",2),1,2)_"%"
  1.  ;
  1. OC() ; -- % of occupancy
  1.  N X S X=DGX(6)/ND/$$TOT Q:'X "0.00%" Q $E($P(X,".",2),1,2)_"%"
  1.  ;
  1. ICU() ; -- icu patient days
  1.  N X,D,T,E
  1.  S (X,T)=0 F  S X=$O(^DIC(42,X)) Q:'X  D
  1.  . Q:$P($G(^DIC(42,X,"IHS")),U)'="Y"
  1.  . S D=DGSMON,E=$E(DGEMON,1,5)_"31"
  1.  . F  S D=$O(^ADGWD(X,1,D)) Q:'D!(D>E)  D
  1.  .. S T=T+$P($G(^ADGWD(+X,1,D,0)),U,2)+$P($G(^(0)),U,8)
  1.  Q T
  1.  ;
  1. PCU() ; -- pcu patient days
  1.  N X,D,T,E
  1.  S (X,T)=0 F  S X=$O(^DIC(42,X)) Q:'X  D
  1.  . Q:$P($G(^DIC(42,X,"IHS")),U,5)'=1
  1.  . S D=DGSMON,E=$E(DGEMON,1,5)_"31"
  1.  . F  S D=$O(^ADGWD(X,1,D)) Q:'D!(D>E)  D
  1.  .. S T=T+$P($G(^ADGWD(+X,1,D,0)),U,2)+$P($G(^(0)),U,8)
  1.  Q T
  1.  ;
  1. LOS1() ; -- alos, adult
  1.  ;IHS/DSD/ENM 12/08/99 DIV ERROR FIX
  1.  ;Q (DGA(3,6)+DGA(1,6))/(DGA(1,3)+DGA(1,4)+DGA(3,3)+DGA(3,4))
  1.  Q (DGA(3,6)+DGA(1,6))/$S(DGA(1,3)+DGA(1,4)+DGA(3,3)+DGA(3,4)>0:DGA(1,3)+DGA(1,4)+DGA(3,3)+DGA(3,4),1:1)
  1.  ;
  1. LOS2() ; -- alos, ped
  1.  ;IHS/DSD/ENM 05/17/99 DIV ERROR FIX
  1.  ;Q DGA(2,6)/(DGA(2,3)+DGA(2,4))
  1.  Q DGA(2,6)/$S(DGA(2,3)+DGA(2,4)>0:DGA(2,3)+DGA(2,4),1:1)
  1.  ;
  1. LOS4() ; -- alos, ped
  1.  ;IHS/DSD/ENM 05/17/99 DIV ERROR FIX
  1.  ;Q DGA(4,6)/(DGA(4,3)+DGA(4,4))
  1.  Q DGA(4,6)/$S(DGA(4,3)+DGA(4,4)>0:DGA(4,3)+DGA(4,4),1:1)
  1.  ;
  1. TOT() ; -- total # of beds ('nb)
  1.  Q DGBED("AM")+DGBED("AS")+DGBED("PM")+DGBED("PS")+DGBED("O")+DGBED("I")+DGBED("T")+DGBED("AL")+DGBED("MH")+DGBED("P")