source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDWLE.m@ 940

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

initial load of FOIAVistA 6/30/08 version
File size: 5.0 KB
Line 
1SDWLE ;BPOI/TEH - WAITING LIST-ENTER/EDIT;06/12/2002
2 ;;5.3;scheduling;**263,415,446,524**;08/13/93;Build 29
3 ;
4 ;
5 ;******************************************************************
6 ; CHANGE LOG
7 ;
8 ; DATE PATCH DESCRIPTION
9 ; ---- ----- -----------
10 ; 09JUN2005 446 Inter-Facility Transfer.
11 ;
12 ;
13EN ;ENTRY POINT - INTIALIZE VARIABLES
14 N DTOUT,%
15 I $D(SDWLOPT),SDWLOPT G OPT
16 I $D(SDWLLIST),SDWLLIST,$D(DFN),DFN<0 K SDWLLIST
17 I $D(SDWLLIST),SDWLLIST,$D(DFN),DFN'="" S SDWLDFN=DFN D 1^VADPT S (SDWLTEM,SDWLPOS)=0 D HD,SB1 G EN1:'$D(DUOUT) W !,"PATIENT: ",VADM(1),?40,VA("PID") W !,*7,"PATIENT'S DATE OF DEATH HAS BEEN RECORDED" S DIR(0)="E" D ^DIR G END
18 K ^TMP("SDWLD",$J) D HD
19 D PAT G END:DFN<0
20OPT S SDWLPCMM=0,SDWLERR=0 I $D(SDWLOPT),SDWLOPT D
21 .S %=2 W !,"DO YOU WISH TO PLACE THIS PATIENT ON A WAITING LIST " D YN^DICN
22 .I %=-1!(%=2) S SDWLERR=1 Q
23 I $D(SDWLOPT),SDWLOPT,SDWLERR Q
24 S SDWLDFN=DFN
25 D 1^VADPT
26 S (SDWLTEM,SDWLPOS)=0
27EN1 N SDWLNEW,SDWLERR,SDWLCN,SDWLWTE S SDWLNEW=0,SDWLERR=0,SDWLCN=0,SDWLWTE=0
28 G:$$EN^SDWLE6(SDWLDFN,.SDWLERR) EN2 ; OG ; SD*5.3*446 ; Inter-facility transfer
29 D DIS
30 I $D(^SDWL(409.3,"B",DFN)),'SDWLCN W !!,"PATIENT: ",VADM(1),?40,VA("PID")
31 S SDWLPS=$S(SDWLCN>1:1,SDWLCN=1:2,1:3)
32 I $D(SDWLOPT),SDWLOPT,SDWLPS=3 S X="Y" G ENO
33 I SDWLPS=1 S DIR(0)="FOA^^" S DIR("A")="Select Wait List (1-"_SDWLCN_") or Enter 'N' for New or '^' to Quit ? ",DIR("?")="Enter a Valid Number or 'N' for New."
34 I SDWLPS=2 S DIR(0)="FOA^^" S DIR("A")="Select Wait List (1) or Enter 'N' for New or '^' to Quit ? ",DIR("?")="Enter a '1' or 'N' for New."
35 I SDWLPS=3 S DIR(0)="YAO^^S X=""Y""" S DIR("A")="Patient is not on Waiting List. Do you wish to Add Patient? Yes// "
36 W ! D ^DIR W ! K DIR
37 G END:$D(DUOUT),END:$D(DTOUT)
38 I SDWLPS=1 D G EN3:SDWLERR=1 I SDWLERR=2 W *7," ??" G EN1
39 .S SDWLERR=$S(X?1"N".E:0,X?1"n".E:0,X="":2,$D(DUOUT):1,X["^":1,$D(^TMP("SDWLD",$J,DFN,+X)):0,1:2) Q
40 I SDWLPS=2 D G EN3:SDWLERR=1 I SDWLERR=2 W *7," ??" G EN1
41 .S SDWLERR=$S(X?1"N".E:0,X?1"n".E:0,X="":2,$D(DUOUT):1,X["^":1,$D(^TMP("SDWLD",$J,DFN,+X)):0,1:2) Q
42ENO I SDWLPS=3 D G EN3:SDWLERR=1 I SDWLERR=2 W *7," ??" G EN1
43 .S SDWLERR=$S(X?1"N".E:1,X?1"n".E:1,X="":0,X?1"Y".E:0,X?1"y".E:0,$D(DUOUT):1,X["^":1,1:2) Q
44 I SDWLPS=1!(SDWLPS=2),X?1N.N D
45 .N DA,SDWLDA S (DA,SDWLDA)=$P($G(^TMP("SDWLD",$J,DFN,+X)),"~",2),SDWLEDIT=""
46 .;
47 .;LOCK DATA FILE
48 .;
49 .L +^SDWL(409.3,DA):5 I '$T W !,"ANOTHER TERMINAL IS EDITING THIS ENTRY. TRY LATER." S DUOUT=1
50 .I $D(DUOUT) Q
51 .N SDWLINNM,SDWLSTN ; OG ; This and the following six lines added for patch 415
52 .I $$GETTRN^SDWLIFT1(SDWLDA,.SDWLINNM,.SDWLSTN) D S DUOUT=1 Q
53 ..N SDWLMSG,SDWLI
54 ..S SDWLMSG(0)=1,SDWLMSG(SDWLMSG(0),0)="This entry is the subject of a transfer to "_SDWLINNM_" ("_SDWLSTN_"). Editing inhibited."
55 ..I $L(SDWLMSG(SDWLMSG(0),0))>80 D COL80^SDWLIFT(.SDWLMSG)
56 ..F SDWLI=1:1:SDWLMSG(0) W !,SDWLMSG(SDWLI,0)
57 ..Q
58 .D EN^SDWLE10
59 .D EDIT W !!,"Editing is Completed" S SDWLERR=1 K SDWLEDIT
60 G END:SDWLERR
61 I SDWLPS=1!(SDWLPS=2),X?1"N".E!(X?1"n".E) D NEW,EDIT S SDWLNEW="" G EN2
62 I SDWLPS=3 D NEW,EDIT S SDWLNEW=""
63EN2 I $D(SDWLNEW),'$D(DUOUT),'SDWLERR W !!,?15,"*** Patient has been added to Wait List ***",!
64 K SDWLNEW,DUOUT
65 ;
66 ;UNLOCK FILE AND KILL LOCAL VARIABLES
67 ;
68 I $D(SDWLDA) L -^SDWL(409.3,SDWLDA)
69 ;-exit logic
70EN3 D END^SDWLE113
71 Q
72END D END^SDWLE113
73 D EN^SDWLKIL
74 Q
75 ;
76 ;
77PAT ;SELECT PATIENT
78 ;
79 S DIC(0)="EMNZAQ",DIC=2 D ^DIC S (SDWLDFN,DFN)=$P(Y,U,1) G PAT1:DFN<0
80 S X=$$GET1^DIQ(2,DFN_",",".351") I X'="" W !,*7,"PATIENT'S DATE OF DEATH HAS BEEN RECORDED" G PAT
81 S SDWLSSN=$G(VA("PID")),SDWLNAM=$G(VA(1))
82PAT1 K VADM,VAIN,VAERR,VA Q
83 ;
84DIS ;DISPLAY DATA FOR PATIENT
85 ;
86 S SDWLHDR="Wait List Enter/Edit"
87 D EN^SDWLD(DFN,VA("PID"),VADM(1))
88 D PCM^SDWLE1,PCMD^SDWLE1
89 Q
90 ;
91NEW ;
92 D NEW^SDWLE11
93 Q
94 ;
95EDIT ;
96 D EN^SDWLE111 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
97 I SDWLTYE=4 D ED4 K DIR,DIE,DIC,DR Q
98 I SDWLTYE=3 D ED3 K DIR,DIE,DIC,DR Q
99 I SDWLTYE=2 D ED2 K DIR,DIE,DIC,DR Q
100 I SDWLTYE=1 D ED1 K DIR,DIE,DIC,DR Q
101 Q
102ED1 ;-team
103 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
104 D EN^SDWLE3 I '$D(DUOUT) D EN^SDWLE113 Q
105 Q
106ED2 ;-position
107 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
108 D EN^SDWLE5 I '$D(DUOUT) D EN^SDWLE113 Q
109 Q
110ED3 ;-specialty
111 D EN^SDWLE2 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
112 D EN^SDWLE110 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
113 I '$D(DUOUT) D EN^SDWLE113
114 D END^SDWLE113
115 Q
116ED4 ;-clinic
117 D EN^SDWLE4 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
118 D EN^SDWLE110 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
119 I '$D(DUOUT) D EN^SDWLE113
120 D END^SDWLE113
121 Q
122 ;
123ED5 D END^SDWLE113
124 Q
125SB1 S X=$$GET1^DIQ(2,DFN_",",".351") I X'="" S DUOUT=""
126 Q
127HD W:$D(IOF) @IOF W !,?80-$L("Scheduling/PCMM Enter/Edit Wait List")\2,"Scheduling/PCMM Enter/Edit Wait List",!!
128 I $D(DFN),DFN'="",'$D(^SDWL(409.3,"B",DFN)),$D(SDWLLIST),SDWLLIST D
129 .W !!,"PATIENT: ",VADM(1),?40,VA("PID")
130 Q
Note: See TracBrowser for help on using the repository browser.