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

DWCNST04.m

Go to the documentation of this file.
  1. DWCNST04 ;NEW PROGRAM [ 11/13/96 11:18 AM ]
  1. ;WRITTEN BY DAN WALZ PIMC TO DISPLAY LOGIN USER'S ACTIVE
  1. ;CLINICAL CONSULTATIONS
  1. ;
  1. I '$D(DUZ) W !,"DUZ not set ABORTING..." H 3 Q
  1. I '$D(^VA(200,DUZ,0)) W "Unable to verify user. ABORTING..." H 3 Q
  1. S USR=$P(^VA(200,DUZ,0),"^",1)
  1. D ^DWSETSCR,^%AUCLS,HEAD,FQ G:$D(XIT) XIT D PRT
  1. XIT K XIT,USR,IOP,DIR
  1. D KILL^DWSETSCR
  1. Q
  1. ;
  1. PRT K IOP
  1. Q:'$D(FLDS)
  1. S DIC=1966180,L=0,BY="3,16,.01;S1",FR(1)="A",FR(2)=USR,FR(3)=2900101,TO(1)="A",TO(2)=USR,TO(3)=3901231
  1. S DHD="Active Consults for "_USR_". ( **CONFIDENTIAL** )"
  1. D EN1^DIP
  1. Q
  1. ;
  1. W IV_"Display ACTIVE consults for "_USR_NO,!
  1. Q
  1. FQ S DIR(0)="S^Q:Quick List;F:Full List",DIR("A")="Select the Type of Report ",DIR("B")="Q",DIR("?")="Select 'Q' for a short report, or 'F' for a full report."
  1. D ^DIR
  1. K DIR
  1. I $D(DTOUT)!($D(DUOUT)) S XIT="" Q
  1. S FLDS=$S(Y="Q":"[1966180-MY-ACTIVE-QUICK]",1:"[1966180-FULL]")
  1. Q