source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDWLMR.m@ 1397

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1SDWLMR ;;IOFO BAY PINES/TEH - WAIT LIST - DISPOSITION WAIT LIST ENTRY;06/12/2002 ; 20 Aug 2002 2:10 PM
2 ;;5.3;scheduling;**263**;AUG 13 1993
3 ;
4 ;
5 ;******************************************************************
6 ; CHANGE LOG
7 ;
8 ; DATE PATCH DESCRIPTION
9 ; ---- ----- -----------
10 ;
11 ;
12 ;
13 ;
14 ;
15 ;
16EN ;
17 ;OPTION HEADER
18 N SDWLDA,SDWLDFN,SDWLCN,SDWLPS,SDWLY
19 ;
20 D HD
21 ;
22 ;PATIENT LOOK-UP FROM WAIT LIST PATIENT FILE (^SDWL(409.3,IEN,0).
23 ;
24 D PAT G END:'$D(SDWLDA),END:'$D(SDWLDFN)
25 ;
26 ;DISPLAY PATIENT DATA FROM ^SDWL(409.3,IEN,0).
27 ;
28 D DIS
29 ;
30 ;PROMPT USER FOR MEDICAL REVIEW ENTRY
31 ;
32 S SDWLPS=$S(SDWLCN>1:1,SDWLCN=1:2,1:1)
33 I SDWLPS=1 S DIR(0)="FOA^^" S DIR("A")="Select Wait List (1-"_SDWLCN_")? "
34 I SDWLPS=2 S DIR(0)="FOA^^" S DIR("A")="Edit this 'Entry'? 1// "
35 W ! D ^DIR S SDWLY=Y W !
36 I SDWLPS=2,'SDWLY S SDWLY=1
37 I SDWLPS=1!(SDWLPS=2) I SDWLY?1N.N D
38 .;
39 .;CHECK FOR VALID ENTRY
40 .;
41 .I '$D(^TMP("SDWLD",$J,SDWLDFN,+SDWLY)) W !,"Invalid Entry " Q
42 .S SDWLDA=$P($G(^TMP("SDWLD",$J,SDWLDFN,+SDWLY)),"~",2)
43 .;
44 .;LOCK DATA FILE
45 .;
46 .L +^SDWL(409.3,SDWLDA):5 I '$T W !,"Another Terminal is Editting this Entry! Try Later." S DUOUT=1
47 I $D(DUOUT) Q
48 ;
49 ;GET PATIENT DATA FROM ^SDWL(409.3,IEN,0).
50 ;
51 D GETDATA
52 ;
53 ;ADVANCED DISPLAY OF PATIENT FIELDS IN ^SDWL(409.3,IEN,0)
54 ;
55 ;FIELD DESCRIPTION REQUIRED
56 ;----- ----------- --------
57 ;
58 ; 13 MEDICAL REVIEW COMPLETED
59 ; 14 MEDICAL REVIEW DATE
60 ; 15 MEDICAL REVIEW USER
61 ;
62 D DISP
63 ;
64 ;ENTER DISPOSITION
65 ;
66 D EDIT
67 L -^SDWL(409.3,SDWLDA)
68 ;
69 Q
70PAT ;PATIENT LOOK-UP
71 ;
72 S DIC(0)="AQEMNZ",DIC="^SDWL(409.3,",DIC("A")="ENTER WAIT LIST PATIENT NAME: " D ^DIC
73 G PATEND:Y<0
74 N DFN S (SDWLDFN,DFN)=$P(Y,U,2),SDWLDA=$P(Y,U,1)
75 D 1^VADPT
76PATEND Q
77 ;
78DIS ;DISPLAY DATA FOR PATIENT
79 ;
80 D EN^SDWLD(SDWLDFN,VA("PID"),VADM(1))
81 Q
82GETDATA ;PATIENT DATA RETRIEVAL
83 ;
84 S SDWLDATA=$G(^SDWL(409.3,SDWLDA,0))
85 S SDWLIN=$P(SDWLDATA,U,3),SDWLCL=+$P(SDWLDATA,U,4),SDWLTY=$P(SDWLDATA,U,5),SDWLST=$P(SDWLDATA,U,6)
86 S SDWLSP=$P(SDWLDATA,U,7),SDWLSS=$P(SDWLDATA,U,8),SDWLSC=$P(SDWLDATA,U,9),SDWLPRI=$P(SDWLDATA,U,10),SDWLRB=$P(SDWLDATA,U,11)
87 I SDWLSP'="" S SDWLTYN=SDWLSP
88 I SDWLSS'="" S SDWLTYN=SDWLSS
89 I SDWLSC'="" S SDWLTYN=SDWLSC
90 I SDWLST'="" S SDWLTYN=SDWLST
91 S SDWLPROV=$P(SDWLDATA,U,12),SDWLDAPT=$P(SDWLDATA,U,16),SDWLST=$P(SDWLDATA,U,17),SDWLDUZ=DUZ,SDWLEDT=DT
92 Q
93DISP ;DISPLAY
94 W !,"Wait List: ",$$EXTERNAL^DILFD(409.3,4,,SDWLTY),?40,"Date Entered: ",$$GET1^DIQ(409.3,SDWLDA,14,,,)
95 W !,"Priority: ",$$GET1^DIQ(409.3,SDWLDA,SDWLPRI,,,),?20,"Institution: ",$$GET1^DIQ(409.3,SDWLDA,SDWLIN,,,)
96 W ?40,"Entered By: ",$$GET1^DIQ(409.3,SDWLDA,9,,,)
97 W !,"Requesting Provider: ",$$GET1^DIQ(409.3,SDWLDA,15,,,),?40,"Date Desired: ",$$GET1^DIQ(409.3,SDWLDA,16,,,)
98 Q
99 ;
100EDIT ;ENTER/EDIT DISPOSITION
101 ;
102 S DIE="^SDWL(409.3,",DA=SDWLDA,DR="13Medical Record Documented " D ^DIE
103 S DR="14Date Medical Review Completed " D ^DIE
104 S DR="15Completed By " D ^DIE
105 Q
106 ;
107HD ;HEADER
108 ;
109 W:$D(IOF) @IOF W !!,?80-$L("WAIT LIST - DISPOSITION PATIENT")\2,"WAIT LIST - DISPOSITION PATIENT",!!
110 ;
111END ;QUIT OPTION
112 Q
Note: See TracBrowser for help on using the repository browser.