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

DWCNST03.m

Go to the documentation of this file.
  1. DWCNST03 ;NEW PROGRAM [ 07/07/1999 4:37 PM ]
  1. ; vjm 5/12/99 - this routine re-written by vjm from
  1. ; WALZ's original rtn: DWCNST03
  1. ; WALZ's rtn comment:
  1. ; WRITTEN BY DAN WALZ PIMC TO ALLOW REVIEW OF PENDING CONSULTATIONS
  1. ;
  1. ; Global information:
  1. ; ^DWCNST01( = PIMC-CONSULTATION-REQUESTS file
  1. ; ^DWCNST03( = PIMC-CONSULTATION-OTHER-SVC file
  1. ; ^DIC(49 = SERVICE/SECTION file
  1. ;
  1. I '$D(DUZ) Q
  1. I '$D(^VA(200,DUZ,0)) Q
  1. I '$P($G(^VA(200,DUZ,5)),U) W "No SERVICE/SECTION found for this user!!" Q
  1. S SVCN=$P($G(^VA(200,DUZ,5)),U)
  1. Q:SVCN=0
  1. Q:'$D(^DIC(49,SVCN,0)) ;Quit if this SERVICE/SECTION is not found
  1. S XXIV=$C(27)_"[7m"
  1. ;S XXIV="""[7m"""
  1. S XXNO=$C(27)_$C(91)_$C(109)
  1. Q:'$D(^DWCNST01("C","R")) ;Quit if there are no "R"equest x-refs
  1. ; ; in the "C" x-ref (STATUS fld)
  1. D PROCESS
  1. K SVCN
  1. ;switch service if user found in ^DWNCST03 1966195
  1. I $D(^DWCNST03("B",DUZ)) D OTHER,PROCESS
  1. W !,"Press <Return> to Acknowledge..." R XXX:15
  1. K XXIV,XXNO
  1. XIT ;K SVCN,SVC,XXCNT,XXIII,DWDFN,XXIV,XXNO,OSIE,XXX
  1. K SVCN,SVC,XXCNT,XXIII,DWDFN,OSIE,XXX
  1. ;K XXIV,XXNO
  1. Q
  1. ;
  1. ;---------------------------------------------------------------------
  1. PROCESS ; process & display # of consults for this SERVICE
  1. S SVC=$P(^DIC(49,SVCN,0),U,1)
  1. S XXCNT=0,DWDFN=0
  1. F XXIII=0:0 S DWDFN=+$O(^DWCNST01("C","R",DWDFN)) Q:DWDFN=0 I $D(^DWCNST01("D",SVCN,DWDFN)) S XXCNT=XXCNT+1
  1. I XXCNT=0 D XIT Q
  1. ;W !,XXIV_SVC_" service has "_XXCNT_" new consultation request"_$S(XXCNT>1:"s",1:"")_"."_XXNO,!,"Press <Return> to Acknowledge..." R XXX:15
  1. W !,XXIV_SVC_" service has "_XXCNT_" new consultation request"_$S(XXCNT>1:"s",1:"")_"."_XXNO
  1. D XIT
  1. Q
  1. ;
  1. ;
  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(^DWCNST03(OSIE,0),U,2)
  1. I SVCN=0 K SVCN
  1. Q