- DGRURB ; ALB/SCK - LIST MANAGER INTERFACE FOR ROOM-BED TRANSLATION; 16-FEB-2000
- ;;5.3;Registration;**190,312**;Aug 13, 1993
- ;
- EN ; -- main entry point for DGRU ROOM-BED
- K XQORS,VALMEVL
- N VALMCNT,DGRUCNT,VALMI,VALMY,XQORNOD,VALMBCK,VALMHDR
- D EN^VALM("DGRU ROOM-BED")
- Q
- ;
- HDR ; -- header code
- S VALMHDR(1)="RAI/MDS COTS Room-Bed Translation"
- S VALMHDR(2)="Data Entry Screen"
- Q
- ;
- INIT ; -- init variables and list array
- ; Variables
- ; DGIEN - ien of the file #46.13 entry
- ; DGNODE - Zero node of file #46.13
- ; DGCNT - Count of entries in the LM array
- ; DGTRN - File #46.13 ien^translated Room-Bed^Bed description
- ; DGRM - Room-Bed name in external format
- ;
- N DGIEN,DGNODE,DGTRN,DGCNT,X,DGRM
- ;
- K ^TMP("DGRURB",$J)
- K ^TMP("DGRUSRT",$J)
- ;
- D CLEAN^VALM10
- ;; Sort Room-Beds first
- S (DGIEN,VALMCNT)=0
- F S DGIEN=$O(^DGRU(46.13,DGIEN)) Q:'DGIEN D
- . S DGNODE=$G(^DGRU(46.13,DGIEN,0))
- . Q:DGNODE']""
- . 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)
- ;
- ;; Build display list
- S DGRM="",DGCNT=1
- F S DGRM=$O(^TMP("DGRUSRT",$J,DGRM)) Q:DGRM="" D
- . S DGIEN=0
- . F S DGIEN=$O(^TMP("DGRUSRT",$J,DGRM,DGIEN)) Q:'DGIEN D
- . . S DGTRN=^TMP("DGRUSRT",$J,DGRM,DGIEN)
- . . S X=$$SETFLD^VALM1(DGCNT,"","NUM")
- . . S X=$$SETFLD^VALM1(DGRM,X,"VISTA")
- . . S X=$$SETFLD^VALM1($P(DGTRN,"^",2),X,"COTS")
- . . S X=$$SETFLD^VALM1($P(DGTRN,"^",3),X,"RMDESC")
- . . D SET(X,DGCNT,+DGTRN)
- . . S DGCNT=DGCNT+1
- Q
- ;
- HELP ; -- help code
- S X="?" D DISP^XQORM1 W !!
- Q
- ;
- EXIT ; -- exit code
- K ^TMP("DGRURB",$J)
- K ^TMP("DGRUSRT",$J)
- D FULL^VALM1
- D CLEAN^VALM10
- Q
- ;
- ADD ; Add a new room-bed translation value
- N DIR,DIRUT,DGVM,DGTR,FDA
- ;
- D FULL^VALM1
- S DIR(0)="PAO^405.4:EMZ",DIR("A")="Vista Room-Bed: "
- S DIR("S")="I $$RAI^DGRURB(Y)"
- D ^DIR K DIR
- Q:$D(DIRUT)
- S DGVM=+Y
- ;
- K DIRUT
- S DIR(0)="FA^3:8^K:'X?.5UN1""-"".2UN"
- S DIR("A")="Enter Translated Room-Bed: "
- S DIR("?",1)="Answer must be 3-8 characters in length"
- S DIR("?",2)="in the format xxxxx-xx, where the first piece does"
- S DIR("?")="not exceed 5 characters, and the second does not exceed 2."
- D ^DIR K DIR
- Q:$D(DIRUT)
- S DGTR=$G(Y)
- ;
- S FDA(1,46.13,"?+1,",.01)=DGVM
- S FDA(1,46.13,"?+1,",.02)=DGTR
- D UPDATE^DIE("","FDA(1)")
- ;
- D INIT
- Q
- ;
- DEL ; Delete an existing room-bed translation value
- N DA,DIK
- ;
- D FULL^VALM1
- D EN^VALM2(XQORNOD(0),"OS")
- S VALMI=0
- S VALMI=$O(VALMY(VALMI))
- Q:'VALMI
- ;
- S DIR(0)="YAO",DIR("A")="Are you sure you want to delete this translation? "
- S DIR("B")="NO"
- D ^DIR K DIR
- Q:$D(DIRUT)
- I Y D
- . S DA=^TMP("DGRURB",$J,"IDX",VALMI,VALMI)
- . S DIK="^DGRU(46.13,"
- . D ^DIK
- . D INIT
- Q
- ;
- RAI(DGIEN) ; Screening logic for room lookup. Associated ward must have the
- ; RAI/MDS WARD field = "Yes"
- N DGOK,DGNDX
- ;
- S DGNDX=0,DGOK=0
- F S DGNDX=$O(^DG(405.4,DGIEN,"W",DGNDX)) Q:'DGNDX D G:DGOK=1 EXITSC
- . S DGOK=$$GET1^DIQ(42,DGNDX,.035,"I")
- EXITSC Q DGOK
- ;
- SET(X,DGCNT,DGIEN) ;
- S VALMCNT=$G(VALMCNT)+1
- S ^TMP("DGRURB",$J,VALMCNT,0)=X
- S ^TMP("DGRURB",$J,"IDX",VALMCNT,DGCNT)=DGIEN
- S ^TMP("DGRURB",$J,"INIT",VALMCNT,DGCNT)=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGRURB 3282 printed Feb 19, 2025@00:24:43 Page 2
- DGRURB ; ALB/SCK - LIST MANAGER INTERFACE FOR ROOM-BED TRANSLATION; 16-FEB-2000
- +1 ;;5.3;Registration;**190,312**;Aug 13, 1993
- +2 ;
- EN ; -- main entry point for DGRU ROOM-BED
- +1 KILL XQORS,VALMEVL
- +2 NEW VALMCNT,DGRUCNT,VALMI,VALMY,XQORNOD,VALMBCK,VALMHDR
- +3 DO EN^VALM("DGRU ROOM-BED")
- +4 QUIT
- +5 ;
- HDR ; -- header code
- +1 SET VALMHDR(1)="RAI/MDS COTS Room-Bed Translation"
- +2 SET VALMHDR(2)="Data Entry Screen"
- +3 QUIT
- +4 ;
- INIT ; -- init variables and list array
- +1 ; Variables
- +2 ; DGIEN - ien of the file #46.13 entry
- +3 ; DGNODE - Zero node of file #46.13
- +4 ; DGCNT - Count of entries in the LM array
- +5 ; DGTRN - File #46.13 ien^translated Room-Bed^Bed description
- +6 ; DGRM - Room-Bed name in external format
- +7 ;
- +8 NEW DGIEN,DGNODE,DGTRN,DGCNT,X,DGRM
- +9 ;
- +10 KILL ^TMP("DGRURB",$JOB)
- +11 KILL ^TMP("DGRUSRT",$JOB)
- +12 ;
- +13 DO CLEAN^VALM10
- +14 ;; Sort Room-Beds first
- +15 SET (DGIEN,VALMCNT)=0
- +16 FOR
- SET DGIEN=$ORDER(^DGRU(46.13,DGIEN))
- if 'DGIEN
- QUIT
- Begin DoDot:1
- +17 SET DGNODE=$GET(^DGRU(46.13,DGIEN,0))
- +18 if DGNODE']""
- QUIT
- +19 SET ^TMP("DGRUSRT",$JOB,$EXTRACT($$GET1^DIQ(405.4,+DGNODE,.01),1,20),+DGNODE)=DGIEN_"^"_$PIECE(DGNODE,"^",2)_"^"_$EXTRACT($$GET1^DIQ(405.4,+DGNODE,.02),1,30)
- End DoDot:1
- +20 ;
- +21 ;; Build display list
- +22 SET DGRM=""
- SET DGCNT=1
- +23 FOR
- SET DGRM=$ORDER(^TMP("DGRUSRT",$JOB,DGRM))
- if DGRM=""
- QUIT
- Begin DoDot:1
- +24 SET DGIEN=0
- +25 FOR
- SET DGIEN=$ORDER(^TMP("DGRUSRT",$JOB,DGRM,DGIEN))
- if 'DGIEN
- QUIT
- Begin DoDot:2
- +26 SET DGTRN=^TMP("DGRUSRT",$JOB,DGRM,DGIEN)
- +27 SET X=$$SETFLD^VALM1(DGCNT,"","NUM")
- +28 SET X=$$SETFLD^VALM1(DGRM,X,"VISTA")
- +29 SET X=$$SETFLD^VALM1($PIECE(DGTRN,"^",2),X,"COTS")
- +30 SET X=$$SETFLD^VALM1($PIECE(DGTRN,"^",3),X,"RMDESC")
- +31 DO SET(X,DGCNT,+DGTRN)
- +32 SET DGCNT=DGCNT+1
- End DoDot:2
- End DoDot:1
- +33 QUIT
- +34 ;
- HELP ; -- help code
- +1 SET X="?"
- DO DISP^XQORM1
- WRITE !!
- +2 QUIT
- +3 ;
- EXIT ; -- exit code
- +1 KILL ^TMP("DGRURB",$JOB)
- +2 KILL ^TMP("DGRUSRT",$JOB)
- +3 DO FULL^VALM1
- +4 DO CLEAN^VALM10
- +5 QUIT
- +6 ;
- ADD ; Add a new room-bed translation value
- +1 NEW DIR,DIRUT,DGVM,DGTR,FDA
- +2 ;
- +3 DO FULL^VALM1
- +4 SET DIR(0)="PAO^405.4:EMZ"
- SET DIR("A")="Vista Room-Bed: "
- +5 SET DIR("S")="I $$RAI^DGRURB(Y)"
- +6 DO ^DIR
- KILL DIR
- +7 if $DATA(DIRUT)
- QUIT
- +8 SET DGVM=+Y
- +9 ;
- +10 KILL DIRUT
- +11 SET DIR(0)="FA^3:8^K:'X?.5UN1""-"".2UN"
- +12 SET DIR("A")="Enter Translated Room-Bed: "
- +13 SET DIR("?",1)="Answer must be 3-8 characters in length"
- +14 SET DIR("?",2)="in the format xxxxx-xx, where the first piece does"
- +15 SET DIR("?")="not exceed 5 characters, and the second does not exceed 2."
- +16 DO ^DIR
- KILL DIR
- +17 if $DATA(DIRUT)
- QUIT
- +18 SET DGTR=$GET(Y)
- +19 ;
- +20 SET FDA(1,46.13,"?+1,",.01)=DGVM
- +21 SET FDA(1,46.13,"?+1,",.02)=DGTR
- +22 DO UPDATE^DIE("","FDA(1)")
- +23 ;
- +24 DO INIT
- +25 QUIT
- +26 ;
- DEL ; Delete an existing room-bed translation value
- +1 NEW DA,DIK
- +2 ;
- +3 DO FULL^VALM1
- +4 DO EN^VALM2(XQORNOD(0),"OS")
- +5 SET VALMI=0
- +6 SET VALMI=$ORDER(VALMY(VALMI))
- +7 if 'VALMI
- QUIT
- +8 ;
- +9 SET DIR(0)="YAO"
- SET DIR("A")="Are you sure you want to delete this translation? "
- +10 SET DIR("B")="NO"
- +11 DO ^DIR
- KILL DIR
- +12 if $DATA(DIRUT)
- QUIT
- +13 IF Y
- Begin DoDot:1
- +14 SET DA=^TMP("DGRURB",$JOB,"IDX",VALMI,VALMI)
- +15 SET DIK="^DGRU(46.13,"
- +16 DO ^DIK
- +17 DO INIT
- End DoDot:1
- +18 QUIT
- +19 ;
- RAI(DGIEN) ; Screening logic for room lookup. Associated ward must have the
- +1 ; RAI/MDS WARD field = "Yes"
- +2 NEW DGOK,DGNDX
- +3 ;
- +4 SET DGNDX=0
- SET DGOK=0
- +5 FOR
- SET DGNDX=$ORDER(^DG(405.4,DGIEN,"W",DGNDX))
- if 'DGNDX
- QUIT
- Begin DoDot:1
- +6 SET DGOK=$$GET1^DIQ(42,DGNDX,.035,"I")
- End DoDot:1
- if DGOK=1
- GOTO EXITSC
- EXITSC QUIT DGOK
- +1 ;
- SET(X,DGCNT,DGIEN) ;
- +1 SET VALMCNT=$GET(VALMCNT)+1
- +2 SET ^TMP("DGRURB",$JOB,VALMCNT,0)=X
- +3 SET ^TMP("DGRURB",$JOB,"IDX",VALMCNT,DGCNT)=DGIEN
- +4 SET ^TMP("DGRURB",$JOB,"INIT",VALMCNT,DGCNT)=""
- +5 QUIT