Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLE.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLE.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLE.m
r613 r623 1 SDWLE ;BPOI/TEH - WAITING LIST-ENTER/EDIT;06/12/20022 ;;5.3;scheduling;**263,415,446,524**;08/13/93;Build 29 3 4 5 6 7 8 9 10 11 12 13 EN 14 15 16 17 18 19 20 OPT 21 22 23 24 25 26 27 EN1 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 ENO 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 EN2 64 65 66 67 68 69 70 EN3 71 72 END 73 74 75 76 77 PAT 78 79 80 81 82 PAT1 83 84 DIS 85 86 87 88 89 90 91 NEW 92 93 94 95 EDIT 96 97 98 99 100 101 102 ED1 103 104 105 106 ED2 107 108 109 110 ED3 111 112 113 114 115 116 ED4 117 118 119 120 121 122 123 ED5 124 125 SB1 126 127 HD 128 129 130 1 SDWLE ;;IOFO BAY PINES/TEH - WAITING LIST-ENTER/EDIT;06/12/2002 ; 20 Aug 2002 2:10 PM 2 ;;5.3;scheduling;**263,446**;AUG 13 1993;Build 77 3 ; 4 ; 5 ;****************************************************************** 6 ; CHANGE LOG 7 ; 8 ; DATE PATCH DESCRIPTION 9 ; ---- ----- ----------- 10 ; 09JUN2005 446 Inter-Facility Transfer. 11 ; 12 ; 13 EN ;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 20 OPT 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 27 EN1 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 42 ENO 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="" 63 EN2 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 70 EN3 D END^SDWLE113 71 Q 72 END D END^SDWLE113 73 D EN^SDWLKIL 74 Q 75 ; 76 ; 77 PAT ;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)) 82 PAT1 K VADM,VAIN,VAERR,VA Q 83 ; 84 DIS ;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 ; 91 NEW ; 92 D NEW^SDWLE11 93 Q 94 ; 95 EDIT ; 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 102 ED1 ;-team 103 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q 104 D EN^SDWLE3 I '$D(DUOUT) D EN^SDWLE113 Q 105 Q 106 ED2 ;-position 107 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q 108 D EN^SDWLE5 I '$D(DUOUT) D EN^SDWLE113 Q 109 Q 110 ED3 ;-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 116 ED4 ;-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 ; 123 ED5 D END^SDWLE113 124 Q 125 SB1 S X=$$GET1^DIQ(2,DFN_",",".351") I X'="" S DUOUT="" 126 Q 127 HD 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 TracChangeset
for help on using the changeset viewer.
