source: FOIAVistA/trunk/r/AUTOMATED_LAB_INSTRUMENTS-LA/LA7DEDT.m@ 1765

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

initial load of FOIAVistA 6/30/08 version

File size: 4.0 KB
Line 
1LA7DEDT ;DALOI/PWC/RLM-LA7D EDIT FOREIGN COMPUTER INTERFACE FILE ;02/14/2000
2 ;;5.2;AUTOMATED LAB INSTRUMENTS;**53,58**;Sep 27, 1994
3 ; Reference to $$FIND1^DIC supported by IA #2051
4 ; Reference to LIST^DIC supported by IA #2051
5 ; Reference to UPDATE^DIE supported by IA #2053
6 ; Reference to ^DIK supported by IA #10013
7 ; Reference to ^DIR supported by IA #10026
8 ;
9 ; This routine will allow the user to enter a foreign computer
10 ; system name and the supported ward(s) for each name
11 ; (ie. CareVue, Marquette)
12 ;
13 K ^TMP("DIERR",$J)
14 K CNT,DA,DEL,DIERR,DIK,DIR,DIROUT,DIRUT,DONE,DTOUT,DUOUT,FROM
15 K I,IEN,IRESULT,J,LA7D,LA7DERR,LA7DERR1,LA7DIEN,LA7DTMP,LAIEN
16 K LAIENW,OK,WIEN,WWIEN,X,Y
17ADDNEW ;
18 K DIR
19 S DIR("A")="Do you wish to Add or Edit a Bedside Monitor"
20 ;S DIR("?")=""
21 S DIR(0)="S^a:ADD;e:EDIT"
22 S DIR("B")="E"
23 D ^DIR Q:X=""!($D(DIRUT))!($D(DIROUT))
24 G:Y="a" ADD
25NAME ; input the name of the bedside monitor interface
26 D HELPM
27 K DIR S DIR("A")="Enter BEDSIDE MONITOR INTERFACE NAME"
28 S DIR("?")="Enter Bedside Monitor Name (ie. CareVue, Marquette)"
29 S DIR(0)="PO^62.487:LEM"
30 K DIR("B") S DLAYGO="62.487"
31 D ^DIR K DLAYGO Q:X=""!($D(DIRUT))!($D(DIROUT))
32 S IRESULT=$P(Y,"^",2)
33 S LA7DIEN=$S($D(IEN(1)):IEN(1),1:+Y)
34 S DONE=0
35 ;
36WARD ; input the ward # associated with the bedside monitor interface
37 ;
38 D HELPW
39 K DIR S DIR("A")="Enter "_IRESULT_" WARD"
40 S DIR("?")="Enter wards associated with this bedside monitor"
41 S DIR(0)="P^44:EMZ"
42 F J=1:1 D Q:DONE
43 . K DIR("B")
44 . D ^DIR I X=""!($D(DIRUT))!($D(DIROUT)) S DONE=1 Q
45 . S WIEN=+Y
46 . I WIEN=0!(WIEN="") W " Invalid" Q ; does not exist in file 44
47 . K LA7DERR
48 . S WWIEN=$$FIND1^DIC(62.4871,","_LA7DIEN_",","AX",$P(Y,"^",2),,,"LA7DERR")
49 . ;I $D(LA7DERR) K LA7DERR S WWIEN=$$FIND1^DIC(62.4871,","_LA7DIEN_",","AX",$P(Y,"^",2),,,"LA7DERR")
50 . ;I $D(LA7DERR) W !,"There is an error with this entry." Q
51 . I WWIEN'=0 W " already on file" D DELETE Q ; exists in file 62.487
52 . K LA7D,LA7DERR,LAIENW ; does not exist, add to database
53 . F CNT=1:1 Q:'$D(^LAB(62.487,LA7DIEN,1,CNT))
54 . I CNT=LA7DIEN S CNT=CNT+1
55 . S LA7D(62.487,LA7DIEN_",",.01)=IRESULT
56 . S LA7D(62.4871,"?+"_CNT_","_LA7DIEN_",",.01)=WIEN
57 . D UPDATE^DIE("S","LA7D","LAIENW","LA7DERR")
58 . I $D(LA7DERR) W !,$G(LA7DERR("DIERR",1,"TEXT",1))
59EXIT ;
60 K CNT,DA,DEL,DIERR,DIK,DIR,DIROUT,DIRUT,DONE,DTOUT,DUOUT,FROM
61 K I,IEN,IRESULT,J,LA7D,LA7DERR,LA7DERR1,LA7DIEN,LA7DTMP,LAIEN
62 K LAIENW,OK,WIEN,WWIEN,X,Y
63 K ^TMP("DIERR",$J)
64 Q
65 ;
66HELPW ; A list of available wards will display before the WARD prompt is issued.
67 ;
68 W !," Current Wards for ",$P(^LAB(62.487,LA7DIEN,0),"^")
69 K LA7DTMP,LA7DERR1 S FROM=""
70 D LIST^DIC(62.4871,","_LA7DIEN_",",.01,,,FROM,,,,,"LA7DTMP","LA7DERR1")
71 F J=1:1 Q:'$D(LA7DTMP("DILIST",1,J)) W !," ",LA7DTMP("DILIST",1,J) I '(J#5) K DIR S DIR(0)="E" D ^DIR Q:'Y
72 Q
73 ;
74HELPM ; A list of available Bedside Monitors will display before the BEDSIDE MONITOR prompt is issued.
75 ;
76 W !," Current Bedside Monitors"
77 K LA7DTMP,LA7DERR1 S FROM=""
78 D LIST^DIC(62.487,,.01,,,FROM,,,,,"LA7DTMP","LA7DERR1")
79 F J=1:1 Q:'$D(LA7DTMP("DILIST",1,J)) W !," ",LA7DTMP("DILIST",1,J) I '(J#5) K DIR S DIR(0)="E" D ^DIR Q:'Y
80 Q
81 ;
82ADD ;Add an entry to 62.487
83 D HELPM
84 K DIR S DIR("A")="Enter the name of the NEW Bedside Monitor"
85 S DIR(0)="F^3:30"
86 D ^DIR Q:X=""!($D(DIRUT))!($D(DIROUT))
87 S Y=$$FIND1^DIC(62.487,,,X,,,"LA7DERRA")
88 S IRESULT=X
89 I Y!(Y="") W !,X_" exists, please select a new name."
90 I Y=0 S DIR("A")=X_" does not exist. Do you wish to add it?" S DIR(0)="Y",DIR("B")="N" D ^DIR G:'Y ADD D
91 . K LA7D ;does not exist, add to database
92 . S LA7D(62.487,"?+1,",.01)=IRESULT
93 . D UPDATE^DIE("ES","LA7D","LAIEN","LA7DERR")
94 . ;do the FIND1^DIC again since we don't know the IEN
95 . S Y=$$FIND1^DIC(62.487,,,X)
96 . S LA7DIEN=LAIEN(1),DONE=0
97 G WARD Q
98DELETE ; delete entry from ^LAB(62.487
99 ;
100 W !,"Ward already on File, DELETE (Y/N) [N] " R DEL:DTIME
101 S:DEL="" DEL="N" Q:DEL="N"!(DEL="^")
102 I DEL'="Y" W $C(7)," Must enter Y or N" G DELETE
103 K DIK,DA S DA(1)=LA7DIEN,DA=WWIEN
104 S DIK="^LAB(62.487,"_DA(1)_",1,"
105 D ^DIK K DIK,DA
106 Q
107ZEOR ;LA7DEDT
Note: See TracBrowser for help on using the repository browser.