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

DWCNST09.m

Go to the documentation of this file.
  1. DWCNST09 ;NEW PROGRAM [ 07/07/1999 11:13 AM ]
  1. ;WRITTEN BY DAN WALZ PIMC TO DISPLAY LOGIN USER'S SERVICE
  1. ;CLINICAL CONSULTATIONS BY DATE RANGE
  1. ;
  1. I '$D(DUZ) W !,"DUZ not set ABORTING..." H 3 D XIT Q
  1. I '$D(^VA(200,DUZ,0)) W "Unable to verify user. ABORTING..." H 3 D XIT Q
  1. S USR=$P(^VA(200,DUZ,0),"^",1)
  1. ;
  1. ;switch service if user found in ^DWNCST03 1966195
  1. K SVCN I $D(^DWCNST03("B",DUZ)) D OTHER
  1. ;
  1. ;the following line is temporary remove after Dr. Hays is
  1. ;no longer acting chief of OB/GYN
  1. ;;;I DUZ=1483 W !!,"Dr. Hays, run this report for OB/GYN rather than Anesthesia" S %=2 D YN^DICN I %=1 S SVCN=40
  1. ;the following line needed while Dr. M. Horton is chief of both
  1. ;SERVICE/SECTION: `23 OPHTHALMOLOGY `24 OTOLARYNGOLOGY (ENT)
  1. ;I DUZ=975 W !!,"Dr. Horton, run this report for ENT rather than EYE" S %=2 D YN^DICN I %=1 S SVCN=24
  1. I DUZ=975 W !!,"Dr. Horton, run this report for EYE rather than ENT" S %=2 D YN^DICN I %=1 S SVCN=23
  1. ;end temporary lines
  1. ;
  1. I '$D(SVCN) I '$D(^VA(200,DUZ,5)) W "Unable to locate Service - ABORTING.." H 3 D XIT Q
  1. I '$D(SVCN) S SVCN=+^(5) I SVCN=0 W "Unable to locate Service - ABORTING.." H 3 D XIT Q
  1. I '$D(^DIC(49,SVCN,0)) W "Unable to locate Service - ABORTING.." H 3 D XIT Q
  1. S SVC=$P(^(0),"^",1)
  1. ;
  1. D ^DWSETSCR,^%AUCLS,HEAD,FQ G:$D(XIT) XIT D DTSEL^DWCNST08 G:Y<0 XIT D PRT
  1. XIT K XIT,USR,IOP,SVCN,SVC,DIR,OSIE,SDT,EDT,%
  1. D KILL^DWSETSCR
  1. Q
  1. ;
  1. PRT K IOP
  1. Q:'$D(FLDS)
  1. S DIC=1966180,L=0,BY="1,.01;S1",FR(1)=SVC,FR(2)=SDT,TO(1)=SVC,TO(2)=EDT
  1. S DHD="All Consults for "_SVC_" Service from "_$E(SDT,4,5)_"/"_$E(SDT,6,7)_"/"_$E(SDT,2,3)_" to "_$E(EDT,4,5)_"/"_$E(EDT,6,7)_"/"_$E(EDT,2,3)_" **CONFIDENTIAL**"
  1. D EN1^DIP
  1. Q
  1. ;
  1. W IV_"Display consults for "_SVC_" by selected date(s)"_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-REQUESTS-QUICK]",1:"[1966180-FULL]")
  1. Q
  1. OTHER ;replace usual service with the entry in ^DWCNST03 1966195
  1. S OSIE=+$O(^DWCNST03("B",DUZ,0))
  1. I '$D(^DWCNST03(OSIE,0)) Q
  1. S SVCN=+$P(^(0),"^",2) I SVCN=0 K SVCN
  1. ;the following line is temporary remove after Dr. Hays is
  1. ;no longer acting chief of OB/GYN
  1. I DUZ=1483 W !!,"Dr. Hays, run this report to OB/GYN rather than Anesthesia" S %=2 D YN^DICN I %=1 S SVCN=40
  1. Q