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

BDGSYS4.m

Go to the documentation of this file. 
  1. BDGSYS4 ; IHS/ANMC/LJF - ROOM-BED SETUP ;  
  1.  ;;5.3;PIMS;**1007,1009**;FEB 27, 2007
  1.  ;
  1.  ;cmi/anch/maw added INITW to show ward on pick list PATCH 1007 item 1007.44
  1.  ;
  1. EN ; -- main entry point for BDG SYS ROOM SETUP
  1.  NEW VALMCNT
  1.  D TERM^VALM0,CLEAR^VALM1
  1.  D EN^VALM("BDG SYS ROOM SETUP")
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. HDR ; -- header code
  1.  NEW X
  1.  S X=$$GET1^DIQ(40.8,BDGDIV,.01)
  1.  S VALMHDR(1)=$$SP(79-$L(X)\2)_X
  1.  Q
  1.  ;
  1. INIT ; -- init variables and list array
  1.  D INITW Q  ;cmi/anch/maw 2/22/2007 added for sort by ward
  1.  ;cmi/anch/maw 2/22/2007 below is orig code, replaced with INITW PATCH 1007 item 1007.44
  1.  D MSG^BDGF("Please wait while I compile the list...",1,0)
  1.  NEW IEN,NAME,COUNT,LINE,INA
  1.  S VALMCNT=0
  1.  K ^TMP("BDGSYS4",$J),^TMP("BDGSYS41",$J)
  1.  ;
  1.  ; sort rooms by active/inactive then name
  1.  S NAME=0 F  S NAME=$O(^DG(405.4,"B",NAME)) Q:NAME=""  D
  1.  . S IEN=0 F  S IEN=$O(^DG(405.4,"B",NAME,IEN)) Q:'IEN  D
  1.  .. S ^TMP("BDGSYS41",$J,$$GET1^DIQ(405.4,IEN,.2),NAME,IEN)=""
  1.  ;
  1.  ; take sorted list and put into display array
  1.  ;    sorted by active/inactive then name
  1.  S INA="" F  S INA=$O(^TMP("BDGSYS41",$J,INA)) Q:INA=""  D
  1.  . ;
  1.  . I INA=1 D SET("",+$G(COUNT),0,.VALMCNT)  ;skip line before inactives
  1.  . ;
  1.  . S NAME=0 F  S NAME=$O(^TMP("BDGSYS41",$J,INA,NAME)) Q:NAME=""  D
  1.  .. S IEN=0 F  S IEN=$O(^TMP("BDGSYS41",$J,INA,NAME,IEN)) Q:'IEN  D
  1.  ... ;
  1.  ... S COUNT=$G(COUNT)+1
  1.  ... S LINE=$J(COUNT,2)_". "_NAME                         ;rooomname
  1.  ... S LINE=$$PAD(LINE,20)_$$GET1^DIQ(405.4,IEN,.02)      ;description
  1.  ... S LINE=$$PAD(LINE,55)_$$GET1^DIQ(405.4,IEN,9999999.01)  ;phone
  1.  ... ;
  1.  ... I $$GET1^DIQ(405.4,IEN,.2)=1 S LINE=$$PAD(LINE,68)_"*INACTIVE*"
  1.  ... D SET(LINE,COUNT,IEN,.VALMCNT)
  1.  ;
  1.  I '$D(^TMP("BDGSYS4",$J)) D
  1.  . D SET("*** NO ENTRIES FOUND ***",0,0,.VALMCNT)
  1.  Q
  1.  ;
  1. INITW ; -- init variables and list array
  1.  ;cmi/anch/maw 2/22/2007 modified code to show ward on list PATCH 1007 item 1007.44
  1.  D MSG^BDGF("Please wait while I compile the list...",1,0)
  1.  NEW IEN,NAME,COUNT,LINE,INA,OEN
  1.  S VALMCNT=0
  1.  K ^TMP("BDGSYS4",$J),^TMP("BDGSYS41",$J)
  1.  ;
  1.  ; sort rooms by active/inactive then name
  1.  S WD=0 F  S WD=$O(^DG(405.4,"W",WD)) Q:'WD  D
  1.  . S NAME=0 F  S NAME=$O(^DG(405.4,"W",WD,NAME)) Q:NAME=""  D
  1.  .. S IEN=0 F  S IEN=$O(^DG(405.4,"W",WD,NAME,IEN)) Q:'IEN  D
  1.  ... ;S ^TMP("BDGSYS41",$J,$$GET1^DIQ(405.4,IEN,.2),WD,NAME,IEN)=""  ;cmi/maw 8/19/2008 orig line patch 1009
  1.  ... S ^TMP("BDGSYS41",$J,$$GET1^DIQ(405.4,NAME,.2),WD,NAME,IEN)=""  ;cmi/maw 8/19/2008 patch 1009 mod line per mitch wright
  1.  ;
  1.  ; take sorted list and put into display array
  1.  ;    sorted by active/inactive then name
  1.  S INA="" F  S INA=$O(^TMP("BDGSYS41",$J,INA)) Q:INA=""  D
  1.  . ;
  1.  . I INA=1 D SET("",+$G(COUNT),0,.VALMCNT)  ;skip line before inactives
  1.  . ;
  1.  . S NAME=0 F  S NAME=$O(^TMP("BDGSYS41",$J,INA,NAME)) Q:NAME=""  D
  1.  .. S IEN=0 F  S IEN=$O(^TMP("BDGSYS41",$J,INA,NAME,IEN)) Q:'IEN  D
  1.  ... S OEN=0 F  S OEN=$O(^TMP("BDGSYS41",$J,INA,NAME,IEN,OEN)) Q:'OEN  D
  1.  .... ;
  1.  .... S COUNT=$G(COUNT)+1
  1.  .... S LINE=$J(COUNT,2)_". "_$P(^DG(405.4,IEN,0),U)_" ("_$$GET1^DIQ(42,NAME,.01)_")"    ;rooomname/ward
  1.  .... S LINE=$$PAD(LINE,20)_$$GET1^DIQ(405.4,IEN,.02)      ;description cmi/maw 8/19/2008 patch 1009 reported mitch wright
  1.  .... ;S LINE=$$PAD(LINE,20)_$$GET1^DIQ(405.4,OEN,.02)      ;description orig line
  1.  .... S LINE=$$PAD(LINE,55)_$$GET1^DIQ(405.4,IEN,9999999.01)  ;phone  cmi/maw 8/19/2008 patch 1009 reported mitch wright
  1.  .... ;S LINE=$$PAD(LINE,55)_$$GET1^DIQ(405.4,OEN,9999999.01)  ;phone orig line
  1.  .... ;
  1.  .... I $$GET1^DIQ(405.4,IEN,.2)=1 S LINE=$$PAD(LINE,68)_"*INACTIVE*"
  1.  .... D SET(LINE,COUNT,IEN,.VALMCNT)
  1.  ;
  1.  I '$D(^TMP("BDGSYS4",$J)) D
  1.  . D SET("*** NO ENTRIES FOUND ***",0,0,.VALMCNT)
  1.  Q
  1.  ;
  1. SET(DATA,NUM,N,LINE) ; put display line into array
  1.  S LINE=LINE+1
  1.  S ^TMP("BDGSYS4",$J,LINE,0)=DATA
  1.  S ^TMP("BDGSYS4",$J,"IDX",LINE,NUM)=N
  1.  Q
  1.  ;
  1. HELP ; -- help code
  1.  S X="?" D DISP^XQORM1 W !!
  1.  Q
  1.  ;
  1. EXIT ; -- exit code
  1.  K ^TMP("BDGSYS4",$J)
  1.  Q
  1.  ;
  1. EXPND ; -- expand code
  1.  Q
  1.  ;
  1. RESET ; -- update partition for return to list manager
  1.  I $D(VALMQUIT) S VALMBCK="Q" Q
  1.  D TERM^VALM0 S VALMBCK="R"
  1.  D HDR,INIT
  1.  Q
  1.  ;
  1. ADD ;EP; called by Add Entry protocol
  1.  NEW DIC,DLAYGO,Y,DDSFILE,DA,DR,DGNEW
  1.  D FULL^VALM1
  1.  S (DIC,DLAYGO)=405.4,DIC(0)="AEMQZL" D ^DIC K DIC I Y<1 D RESET Q
  1.  S DDSFILE=405.4,DA=+Y,DR="[BDG 405.4 SETUP]",DGNEW=1 D ^DDS
  1.  D RESET
  1.  Q
  1.  ;
  1. EDIT ;EP; called by Edit Entry protocol
  1.  NEW X,Y,Z,BDGN,DDSFILE,DA,DR,DGNEW
  1.  D FULL^VALM1
  1.  D EN^VALM2(XQORNOD(0),"OS")
  1.  I '$D(VALMY) Q
  1.  S X=0 F  S X=$O(VALMY(X)) Q:X=""  D
  1.  . ;7/18/02 WAR - REMd next line and changed code per LJF15
  1.  . ;S Y=0 F  S Y=$O(^TMP("BDGSYS4",$J,"IDX",Y)) Q:Y=""  D
  1.  . S Y=0 F  S Y=$O(^TMP("BDGSYS4",$J,"IDX",Y)) Q:Y=""  Q:$G(BDGN)  D
  1.  .. S Z=$O(^TMP("BDGSYS4",$J,"IDX",Y,0))
  1.  .. Q:^TMP("BDGSYS4",$J,"IDX",Y,Z)=""
  1.  .. I Z=X S BDGN=^TMP("BDGSYS4",$J,"IDX",Y,Z)
  1.  ;
  1.  I 'BDGN D RESET Q
  1.  S DDSFILE=405.4,DA=BDGN,DR="[BDG 405.4 SETUP]",DGNEW=1 D ^DDS
  1.  D RESET
  1.  Q
  1.  ;
  1. PAD(D,L) ;EP -- SUBRTN to pad length of data
  1.  ; -- D=data L=length
  1.  Q $E(D_$$REPEAT^XLFSTR(" ",L),1,L)
  1.  ;
  1. SP(N) ; -- SUBRTN to pad N number of spaces
  1.  Q $$PAD(" ",N)