source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDWLSCPE.m@ 643

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1SDWLSCPE ;IOFO BAY PINES/TEH - EWL - EDIT SC PRIORITY ;20 Aug 2002 2:10 PM
2 ;;5.3;scheduling;**394**;AUG 13 1993
3 ;
4 ;
5 ;******************************************************************
6 ; CHANGE LOG
7 ;
8 ; DATE PATCH DESCRIPTION
9 ; ---- ----- -----------
10 ;
11 ;12/09/2004 SD*5.3*394 New routine to edit SC PRIORITY in SDWL(409.3,DA,"SC") Field 15
12 ;
13 ;Variables: DFN not kill - referenced only.
14 ;
15 ;
16 ;
17EN ;Called from option file.
18 S SDWLERR=0 I $D(SDWLLIST),SDWLLIST D
19 .I '$D(DFN) S SDWLERR=1 Q
20 .I $D(DFN),'$D(^SDWL(409.3,"B",DFN)) D HD,1^VADPT,DEM^VADPT W !,VADM(1),?40,VA("PID"),*7,!,"This Patient has NO entries on the Electronic Wait List." S DIR(0)="E" D ^DIR S DUOUT=1 Q
21 I $D(DUOUT) Q
22 I 'SDWLERR,$D(SDWLLIST),SDWLLIST D HD S SDWLDFN=DFN K DIR,DIC,DR,DIE,VADM D 1^VADPT,DEM^VADPT W !,VADM(1),?40,VA("PID") N SDWLBDT S (SDWLBDT,SDWLEDT)="" D DIS G EN1
23 K DIR,DIC,DR,DIE
24 ;OPTION HEADER
25 ;
26 S SDWLOP=" - Edit SC Priority Patient" D HD
27 ;
28 ;PATIENT LOOK-UP FROM WAIT LIST PATIENT FILE (^SDWL(409.3,IEN,0).
29 ;
30 D PAT G END:'$D(SDWLDFN),END:SDWLDFN<0,END:SDWLDFN=""
31 ;
32 ;DISPLAY PATIENT DATA FROM ^SDWL(409.3,IEN,0).
33 ;
34 D DIS
35 ;PROMPT USER FOR RECORD.
36 ;
37EN1 K DIR,DIC,DIE,DR,X,Y,SDWLERR S SDWLPS=$S(SDWLCN>1:1,SDWLCN=1:2,1:0),SDWLERR=0
38 I SDWLPS=0 W !!,"Patient has no Wait List Entries to edit." S DIR(0)="E" D ^DIR G END
39 I SDWLPS=1 S DIR(0)="FOA^^" S DIR("A")="Select Wait List (1-"_SDWLCN_") or '^' to Quit? "
40 I SDWLPS=2 S DIR(0)="FOA^^" S DIR("A")="Edit This 'ENTRY' or '^' to Quit? Yes // "
41 W ! D ^DIR G END:X["^" S SDWLY=Y W !
42 I SDWLPS=1 D
43 .S SDWLERR=$S(X?1N.N:0,X?1"N".E:1,X?1"n".E:1,X="":1,X?1"Y".E:0,X?1"y".E:0,$D(DUOUT):1,X["^":1,1:2)
44 I $D(SDWLERR),SDWLERR=2 W *7," Invalid Entry" G EN1
45 I SDWLPS=2 D
46 .S SDWLERR=$S(X="":0,X?1"Y".E:0,X?1"y":0,X?1"N".E:1,X?1"n".E:1,X["^":1,1:2)
47 I SDWLERR=2 W *7," Invalid Entry" G EN1
48 G END:SDWLERR
49 I SDWLPS=2,'SDWLY S SDWLY=1
50 S SDWLERR=0 I SDWLY?1N.N D G EN1:SDWLERR
51 .K DIR,DIC,DR
52 .;
53 .;CHECK FOR VALID ENTRY
54 .;
55 .I '$D(^TMP("SDWLD",$J,SDWLDFN,+SDWLY)) W " Invalid Entry " S SDWLERR=1 Q
56 .S SDWLDA=$P($G(^TMP("SDWLD",$J,SDWLDFN,+SDWLY)),"~",2)
57 .;
58 .;LOCK DATA FILE
59 .;
60 .L ^SDWL(409.3,SDWLDA):5 I '$T W !,"Another User is Editing this Entry. Try Later." S DUOUT=1
61 I $D(DUOUT) G END
62 ;
63 ;GET PATIENT DATA FROM ^SDWL(409.3,IEN,0).
64 ;
65 D GETDATA
66 ;
67 ;ENTER SERVICE CONNECTED PRIORITY
68 ;
69 D EDIT G END:$D(DUOUT)
70 K DIR,DIE,DR,DIC
71 S DIR(0)="E" D ^DIR I $D(DUOUT) G END
72 D END G EN
73 ;
74 Q
75PAT ;PATIENT LOOK-UP
76 ;
77 S DIC(0)="EMNAQ",DIC=409.3 D ^DIC S (SDWLDFN,DFN)=$P(Y,U,2) G PAT1:DFN<0
78 G PAT1:DFN=""
79 S SDWLNAM=$$GET1^DIQ(2,DFN_",",.01)
80 S X=$$GET1^DIQ(2,DFN_",",".351") I X'="" W !,*7,"PATIENT'S DATE OF DEATH HAS BEEN RECORDED" G PAT
81 D 1^VADPT
82PAT1 Q
83 ;
84DIS ;DISPLAY DATA FOR PATIENT
85 ;
86 S SDWLDISC="",SDWLCN=0,SDWLHDR="Wait List Service Connected Priority Edit"
87 D EN^SDWLD(SDWLDFN,VA("PID"),VADM(1))
88 K VADM,VAIN,VA,SDWLDISC
89 Q
90GETDATA ;PATIENT DATA RETRIEVAL
91 ;
92 S SDWLDATA=$G(^SDWL(409.3,SDWLDA,0))
93 S SDWLIN=$P(SDWLDATA,U,3),SDWLCL=+$P(SDWLDATA,U,4),SDWLTY=$P(SDWLDATA,U,5),SDWLST=$P(SDWLDATA,U,6)
94 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)
95 S SDWLPROV=$P(SDWLDATA,U,12),SDWLDAPT=$P(SDWLDATA,U,16),SDWLST=$P(SDWLDATA,U,17),SDWLDUZ=DUZ,SDWLEDT=DT
96 S SDWLSCP=$P($G(^SDWL(409.3,SDWLDA,"SC")),U,2)
97 Q
98EDIT ;EDIT PRIORITY
99 ;
100 S SDWLDUZ=DUZ,SDWLERR=0 K DIR,DR,DIE,DIC
101 S DIR("A")="Service Connected Priority"
102 S DIR("B")=$$EXTERNAL^DILFD(409.3,15,,SDWLSCP)
103 S DIR(0)="Y"
104 D ^DIR
105 I SDWLSCP>49,X?1."N",X?1"n" W !,"Invalid Entry. Service Connected Percentage greater than 49%" G EDIT
106 I X="" S DUOUT=1 Q
107 I X="^" S DUOUT=1 Q
108 S SDWLSCPX=$S(X?1"Y".E:1,X?1"y".E:1,1:0)
109 D DIE(SDWLDA,SDWLSCPX)
110 Q
111 ;
112DIE(DA,SDWLDIS) ; Update file 409.3 with SERVICE CONNECTED PRIORITY data.
113 S DIE="^SDWL(409.3,"
114 S DR="15///^S X=SDWLSCPX"
115 D ^DIE
116 Q
117HD ;HEADER
118 ;
119 W:$D(IOF) @IOF W !!,?80-$L("Wait List - SERVICE CONNECTED PRIORITY")\2,"Wait List - SERVICE CONNECTED PRIORITY",!!
120 ;
121END ;QUIT OPTION
122 K DIC,DIR,DR,DIE,SDWLDFN,DUOUT,SDWLSCP,SDWLSCPX,SDWLLIST,SDWLCN
123 K SDWLCL,SDWSLCN,SDWLDA,SDWLDAPT,SDWLDATA,SDWLDFN,SDWLDISP,SDWLDUZ,SDWLEDT,SDWLERR,SDWLIN,SDWLNAM,SDWLOP,SDWLPRI
124 K SDWLPROV,SDWLPS,SDWLRB,SDWLSC,SDWLSP,SDWLSS,SDWLST,SDWLTY,SDWLY,X,Y,SDWLHDR
125 L Q
Note: See TracBrowser for help on using the repository browser.