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

ANSUD.m

Go to the documentation of this file.
  1. ANSUD ;IHS/OIRM/DSD/CSC - SELECT DATE/SHIFT/UNIT; [ 02/25/98 10:32 AM ]
  1. ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
  1. ;;SELECT DATE/SHIFT/UNIT
  1. EN ;EP;TO SELECT DATE, SHIFT AND NURSING UNIT
  1. K ANSSH,ANSUN,ANSRB
  1. D DATE
  1. Q:$D(DTOUT)!$D(DUOUT)
  1. D SHIFT
  1. Q:$D(DTOUT)!$D(DUOUT)
  1. D UNIT
  1. Q
  1. DATE ;EP;TO SELECT DATE
  1. I '$D(ANSPAR) S ANSPAR=^ANSD(51,1,0)
  1. I $G(ANSDT)?7N S Y=ANSDT X ^DD("DD") S DIR("B")=Y
  1. D NOW^%DTC ;CSC 10-97
  1. S DIR(0)="DO^:"_X,DIR("A")="Date..........."
  1. D DIR^ANSDIC
  1. Q:$D(DTOUT)!$D(DUOUT)
  1. I $G(Y(0))'="" S ANSDT=Y(0) W " "_ANSDT ;CSC 10-97
  1. I $G(Y)<1 S DUOUT="" Q
  1. S ANSDT=Y
  1. Q
  1. SHIFT ;EP;TO SELECT SHIFT
  1. Q:'$D(ANSPAR)
  1. K ANSSH
  1. S ANSS=$P(ANSPAR,U,5)
  1. S X=$P($T(@ANSS),";;",2)
  1. S DIR(0)="SOA^"_X,DIR("A")="Shift..........: "
  1. S X=$P($T(@ANSS),";;",2),DIR("?")="Choose from: "_$TR(X,":;","- ")
  1. W !
  1. D DIR^ANSDIC
  1. Q:$D(DTOUT)!$D(DUOUT)
  1. I $G(Y)<1 S DUOUT="",ANSSH="" Q ;CSC12-19-96
  1. S ANSSH=+Y
  1. Q
  1. NEWUNIT ;EP;TO ADD NEW NURSING UNITS
  1. K DIC
  1. S DIC(0)="AELMQZ"
  1. UNIT ;EP;TO SELECT NURSING UNIT
  1. Q:'$D(ANSPAR)
  1. K ANSUN
  1. S X=$P(ANSPAR,U,3)
  1. I X,$D(^ANSD(59.1,X,0)) S DIC("B")=$P(^(0),U)
  1. S DIC="^ANSD(59.1,",DIC(0)=$S('$D(DIC(0))#2:"AEMQZ",1:DIC(0)),DIC("A")="Nursing Unit...: "
  1. W !
  1. D DIC^ANSDIC
  1. Q:$D(DTOUT)!$D(DUOUT)
  1. I $G(Y)<1 S DUOUT="" Q
  1. S ANSUN=+Y,ANSUNIT=Y(0)
  1. Q
  1. 2 ;;1:DAY;2:NIGHT
  1. 3 ;;1:DAY;2:EVENING;3:NIGHT