source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGRURB.m@ 1796

Last change on this file since 1796 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.1 KB
Line 
1DGRURB ; ALB/SCK - LIST MANAGER INTERFACE FOR ROOM-BED TRANSLATION; 16-FEB-2000
2 ;;5.3;Registration;**190,312**;Aug 13, 1993
3 ;
4EN ; -- main entry point for DGRU ROOM-BED
5 K XQORS,VALMEVL
6 N VALMCNT,DGRUCNT,VALMI,VALMY,XQORNOD,VALMBCK,VALMHDR
7 D EN^VALM("DGRU ROOM-BED")
8 Q
9 ;
10HDR ; -- header code
11 S VALMHDR(1)="RAI/MDS COTS Room-Bed Translation"
12 S VALMHDR(2)="Data Entry Screen"
13 Q
14 ;
15INIT ; -- init variables and list array
16 ; Variables
17 ; DGIEN - ien of the file #46.13 entry
18 ; DGNODE - Zero node of file #46.13
19 ; DGCNT - Count of entries in the LM array
20 ; DGTRN - File #46.13 ien^translated Room-Bed^Bed description
21 ; DGRM - Room-Bed name in external format
22 ;
23 N DGIEN,DGNODE,DGTRN,DGCNT,X,DGRM
24 ;
25 K ^TMP("DGRURB",$J)
26 K ^TMP("DGRUSRT",$J)
27 ;
28 D CLEAN^VALM10
29 ;; Sort Room-Beds first
30 S (DGIEN,VALMCNT)=0
31 F S DGIEN=$O(^DGRU(46.13,DGIEN)) Q:'DGIEN D
32 . S DGNODE=$G(^DGRU(46.13,DGIEN,0))
33 . Q:DGNODE']""
34 . 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)
35 ;
36 ;; Build display list
37 S DGRM="",DGCNT=1
38 F S DGRM=$O(^TMP("DGRUSRT",$J,DGRM)) Q:DGRM="" D
39 . S DGIEN=0
40 . F S DGIEN=$O(^TMP("DGRUSRT",$J,DGRM,DGIEN)) Q:'DGIEN D
41 . . S DGTRN=^TMP("DGRUSRT",$J,DGRM,DGIEN)
42 . . S X=$$SETFLD^VALM1(DGCNT,"","NUM")
43 . . S X=$$SETFLD^VALM1(DGRM,X,"VISTA")
44 . . S X=$$SETFLD^VALM1($P(DGTRN,"^",2),X,"COTS")
45 . . S X=$$SETFLD^VALM1($P(DGTRN,"^",3),X,"RMDESC")
46 . . D SET(X,DGCNT,+DGTRN)
47 . . S DGCNT=DGCNT+1
48 Q
49 ;
50HELP ; -- help code
51 S X="?" D DISP^XQORM1 W !!
52 Q
53 ;
54EXIT ; -- exit code
55 K ^TMP("DGRURB",$J)
56 K ^TMP("DGRUSRT",$J)
57 D FULL^VALM1
58 D CLEAN^VALM10
59 Q
60 ;
61ADD ; Add a new room-bed translation value
62 N DIR,DIRUT,DGVM,DGTR,FDA
63 ;
64 D FULL^VALM1
65 S DIR(0)="PAO^405.4:EMZ",DIR("A")="Vista Room-Bed: "
66 S DIR("S")="I $$RAI^DGRURB(Y)"
67 D ^DIR K DIR
68 Q:$D(DIRUT)
69 S DGVM=+Y
70 ;
71 K DIRUT
72 S DIR(0)="FA^3:8^K:'X?.5UN1""-"".2UN"
73 S DIR("A")="Enter Translated Room-Bed: "
74 S DIR("?",1)="Answer must be 3-8 characters in length"
75 S DIR("?",2)="in the format xxxxx-xx, where the first piece does"
76 S DIR("?")="not exceed 5 characters, and the second does not exceed 2."
77 D ^DIR K DIR
78 Q:$D(DIRUT)
79 S DGTR=$G(Y)
80 ;
81 S FDA(1,46.13,"?+1,",.01)=DGVM
82 S FDA(1,46.13,"?+1,",.02)=DGTR
83 D UPDATE^DIE("","FDA(1)")
84 ;
85 D INIT
86 Q
87 ;
88DEL ; Delete an existing room-bed translation value
89 N DA,DIK
90 ;
91 D FULL^VALM1
92 D EN^VALM2(XQORNOD(0),"OS")
93 S VALMI=0
94 S VALMI=$O(VALMY(VALMI))
95 Q:'VALMI
96 ;
97 S DIR(0)="YAO",DIR("A")="Are you sure you want to delete this translation? "
98 S DIR("B")="NO"
99 D ^DIR K DIR
100 Q:$D(DIRUT)
101 I Y D
102 . S DA=^TMP("DGRURB",$J,"IDX",VALMI,VALMI)
103 . S DIK="^DGRU(46.13,"
104 . D ^DIK
105 . D INIT
106 Q
107 ;
108RAI(DGIEN) ; Screening logic for room lookup. Associated ward must have the
109 ; RAI/MDS WARD field = "Yes"
110 N DGOK,DGNDX
111 ;
112 S DGNDX=0,DGOK=0
113 F S DGNDX=$O(^DG(405.4,DGIEN,"W",DGNDX)) Q:'DGNDX D G:DGOK=1 EXITSC
114 . S DGOK=$$GET1^DIQ(42,DGNDX,.035,"I")
115EXITSC Q DGOK
116 ;
117SET(X,DGCNT,DGIEN) ;
118 S VALMCNT=$G(VALMCNT)+1
119 S ^TMP("DGRURB",$J,VALMCNT,0)=X
120 S ^TMP("DGRURB",$J,"IDX",VALMCNT,DGCNT)=DGIEN
121 S ^TMP("DGRURB",$J,"INIT",VALMCNT,DGCNT)=""
122 Q
Note: See TracBrowser for help on using the repository browser.