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

DGRURB.m

Go to the documentation of this file.
  1. DGRURB ; ALB/SCK - LIST MANAGER INTERFACE FOR ROOM-BED TRANSLATION; 16-FEB-2000
  1. ;;5.3;Registration;**190,312**;Aug 13, 1993
  1. ;
  1. EN ; -- main entry point for DGRU ROOM-BED
  1. K XQORS,VALMEVL
  1. N VALMCNT,DGRUCNT,VALMI,VALMY,XQORNOD,VALMBCK,VALMHDR
  1. D EN^VALM("DGRU ROOM-BED")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. S VALMHDR(1)="RAI/MDS COTS Room-Bed Translation"
  1. S VALMHDR(2)="Data Entry Screen"
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. ; Variables
  1. ; DGIEN - ien of the file #46.13 entry
  1. ; DGNODE - Zero node of file #46.13
  1. ; DGCNT - Count of entries in the LM array
  1. ; DGTRN - File #46.13 ien^translated Room-Bed^Bed description
  1. ; DGRM - Room-Bed name in external format
  1. ;
  1. N DGIEN,DGNODE,DGTRN,DGCNT,X,DGRM
  1. ;
  1. K ^TMP("DGRURB",$J)
  1. K ^TMP("DGRUSRT",$J)
  1. ;
  1. D CLEAN^VALM10
  1. ;; Sort Room-Beds first
  1. S (DGIEN,VALMCNT)=0
  1. F S DGIEN=$O(^DGRU(46.13,DGIEN)) Q:'DGIEN D
  1. . S DGNODE=$G(^DGRU(46.13,DGIEN,0))
  1. . Q:DGNODE']""
  1. . S ^TMP("DGRUSRT",$J,$E($$GET1^DIQ(405.4,+DGNODE,.01),1,20),+DGNODE)=DGIEN_"^"_$P(DGNODE,"^",2)_"^"_$E($$GET1^DIQ(405.4,+DGNODE,.02),1,30)
  1. ;
  1. ;; Build display list
  1. S DGRM="",DGCNT=1
  1. F S DGRM=$O(^TMP("DGRUSRT",$J,DGRM)) Q:DGRM="" D
  1. . S DGIEN=0
  1. . F S DGIEN=$O(^TMP("DGRUSRT",$J,DGRM,DGIEN)) Q:'DGIEN D
  1. . . S DGTRN=^TMP("DGRUSRT",$J,DGRM,DGIEN)
  1. . . S X=$$SETFLD^VALM1(DGCNT,"","NUM")
  1. . . S X=$$SETFLD^VALM1(DGRM,X,"VISTA")
  1. . . S X=$$SETFLD^VALM1($P(DGTRN,"^",2),X,"COTS")
  1. . . S X=$$SETFLD^VALM1($P(DGTRN,"^",3),X,"RMDESC")
  1. . . D SET(X,DGCNT,+DGTRN)
  1. . . S DGCNT=DGCNT+1
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. K ^TMP("DGRURB",$J)
  1. K ^TMP("DGRUSRT",$J)
  1. D FULL^VALM1
  1. D CLEAN^VALM10
  1. Q
  1. ;
  1. ADD ; Add a new room-bed translation value
  1. N DIR,DIRUT,DGVM,DGTR,FDA
  1. ;
  1. D FULL^VALM1
  1. S DIR(0)="PAO^405.4:EMZ",DIR("A")="Vista Room-Bed: "
  1. S DIR("S")="I $$RAI^DGRURB(Y)"
  1. D ^DIR K DIR
  1. Q:$D(DIRUT)
  1. S DGVM=+Y
  1. ;
  1. K DIRUT
  1. S DIR(0)="FA^3:8^K:'X?.5UN1""-"".2UN"
  1. S DIR("A")="Enter Translated Room-Bed: "
  1. S DIR("?",1)="Answer must be 3-8 characters in length"
  1. S DIR("?",2)="in the format xxxxx-xx, where the first piece does"
  1. S DIR("?")="not exceed 5 characters, and the second does not exceed 2."
  1. D ^DIR K DIR
  1. Q:$D(DIRUT)
  1. S DGTR=$G(Y)
  1. ;
  1. S FDA(1,46.13,"?+1,",.01)=DGVM
  1. S FDA(1,46.13,"?+1,",.02)=DGTR
  1. D UPDATE^DIE("","FDA(1)")
  1. ;
  1. D INIT
  1. Q
  1. ;
  1. DEL ; Delete an existing room-bed translation value
  1. N DA,DIK
  1. ;
  1. D FULL^VALM1
  1. D EN^VALM2(XQORNOD(0),"OS")
  1. S VALMI=0
  1. S VALMI=$O(VALMY(VALMI))
  1. Q:'VALMI
  1. ;
  1. S DIR(0)="YAO",DIR("A")="Are you sure you want to delete this translation? "
  1. S DIR("B")="NO"
  1. D ^DIR K DIR
  1. Q:$D(DIRUT)
  1. I Y D
  1. . S DA=^TMP("DGRURB",$J,"IDX",VALMI,VALMI)
  1. . S DIK="^DGRU(46.13,"
  1. . D ^DIK
  1. . D INIT
  1. Q
  1. ;
  1. RAI(DGIEN) ; Screening logic for room lookup. Associated ward must have the
  1. ; RAI/MDS WARD field = "Yes"
  1. N DGOK,DGNDX
  1. ;
  1. S DGNDX=0,DGOK=0
  1. F S DGNDX=$O(^DG(405.4,DGIEN,"W",DGNDX)) Q:'DGNDX D G:DGOK=1 EXITSC
  1. . S DGOK=$$GET1^DIQ(42,DGNDX,.035,"I")
  1. EXITSC Q DGOK
  1. ;
  1. SET(X,DGCNT,DGIEN) ;
  1. S VALMCNT=$G(VALMCNT)+1
  1. S ^TMP("DGRURB",$J,VALMCNT,0)=X
  1. S ^TMP("DGRURB",$J,"IDX",VALMCNT,DGCNT)=DGIEN
  1. S ^TMP("DGRURB",$J,"INIT",VALMCNT,DGCNT)=""
  1. Q