| 1 | SDWLDISP ;;IOFO BAY PINES/TEH - WAIT LIST - DISPOSITION WAIT LIST ENTRY;06/12/2002 ; 20 Aug 2002 2:10 PM ; Compiled January 26, 2007 10:21:25
|
|---|
| 2 | ;;5.3;scheduling;**263,273,427,454,446**;AUG 13 1993;Build 77
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | ;******************************************************************
|
|---|
| 6 | ; CHANGE LOG
|
|---|
| 7 | ;
|
|---|
| 8 | ; DATE PATCH DESCRIPTION
|
|---|
| 9 | ; ---- ----- -----------
|
|---|
| 10 | ; 11/19/2002 SD*5.3*273 EN1+4 CHECK FOR "^"
|
|---|
| 11 | ; 11/19/2002 SD*5.3*273 REMOVED DIC("S") SCREEN FROM PAT
|
|---|
| 12 | ; 08/07/2008 SD*5.3*446 check out EWL if DFN defined
|
|---|
| 13 | ; 04/12/2006 SD*5.3*446 Inter-facility transfer/New Disposition type: CL
|
|---|
| 14 | ;
|
|---|
| 15 | ;
|
|---|
| 16 | ;
|
|---|
| 17 | EN ;
|
|---|
| 18 | S SDWLERR=0
|
|---|
| 19 | I $D(SDWLLIST),SDWLLIST D
|
|---|
| 20 | .I $G(DFN)'>0 S SDWLERR=1 Q
|
|---|
| 21 | .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
|
|---|
| 22 | I $D(DUOUT) Q
|
|---|
| 23 | 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") S (SDWLBDT,SDWLEDT)="" D DIS G EN1
|
|---|
| 24 | K DIR,DIC,DR,DIE
|
|---|
| 25 | ;OPTION HEADER
|
|---|
| 26 | ;
|
|---|
| 27 | S SDWLOP=" - Disposition Patient" D HD
|
|---|
| 28 | ;
|
|---|
| 29 | ;PATIENT LOOK-UP FROM WAIT LIST PATIENT FILE (^SDWL(409.3,IEN,0).
|
|---|
| 30 | ;
|
|---|
| 31 | D PAT G END:'$D(SDWLDFN),END:SDWLDFN<0,END:SDWLDFN=""
|
|---|
| 32 | ;
|
|---|
| 33 | ;DISPLAY PATIENT DATA FROM ^SDWL(409.3,IEN,0).
|
|---|
| 34 | ;
|
|---|
| 35 | D DIS
|
|---|
| 36 | ;PROMPT USER FOR RECORD FOR DISPOSITIONING.
|
|---|
| 37 | ;
|
|---|
| 38 | EN1 K DIR,DIC,DIE,DR,X,Y,SDWLERR S SDWLPS=$S(SDWLCN>1:1,SDWLCN=1:2,1:0),SDWLERR=0
|
|---|
| 39 | I SDWLPS=0 W !!,"Patient has no Wait List Entries to Disposition." S DIR(0)="E" D ^DIR G END
|
|---|
| 40 | I SDWLPS=1 S DIR(0)="FOA^^" S DIR("A")="Select Wait List (1-"_SDWLCN_") or '^' to Quit? "
|
|---|
| 41 | I SDWLPS=2 S DIR(0)="FOA^^" S DIR("A")="Disposition This 'ENTRY' or '^' to Quit? Yes // "
|
|---|
| 42 | W ! D ^DIR G END:X["^" S SDWLY=Y W !
|
|---|
| 43 | I SDWLPS=1 D
|
|---|
| 44 | .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)
|
|---|
| 45 | I $D(SDWLERR),SDWLERR=2 W *7," Invalid Entry" G EN1
|
|---|
| 46 | I SDWLPS=2 D
|
|---|
| 47 | .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)
|
|---|
| 48 | I SDWLERR=2 W *7," Invalid Entry" G EN1
|
|---|
| 49 | G END:SDWLERR
|
|---|
| 50 | I SDWLPS=2,'SDWLY S SDWLY=1
|
|---|
| 51 | S SDWLERR=0 I SDWLY?1N.N D G EN1:SDWLERR
|
|---|
| 52 | .K DIR,DIC,DR
|
|---|
| 53 | .;
|
|---|
| 54 | .;CHECK FOR VALID ENTRY
|
|---|
| 55 | .;
|
|---|
| 56 | .I '$D(^TMP("SDWLD",$J,SDWLDFN,+SDWLY)) W " Invalid Entry " S SDWLERR=1 Q
|
|---|
| 57 | .S SDWLDA=$P($G(^TMP("SDWLD",$J,SDWLDFN,+SDWLY)),"~",2)
|
|---|
| 58 | .;
|
|---|
| 59 | .;LOCK DATA FILE
|
|---|
| 60 | .;
|
|---|
| 61 | .L ^SDWL(409.3,SDWLDA):5 I '$T W !,"Another User is Editing this Entry. Try Later." S DUOUT=1
|
|---|
| 62 | I $D(DUOUT) G END
|
|---|
| 63 | ;
|
|---|
| 64 | ;GET PATIENT DATA FROM ^SDWL(409.3,IEN,0).
|
|---|
| 65 | ;
|
|---|
| 66 | D GETDATA
|
|---|
| 67 | ;
|
|---|
| 68 | ;ENTER DISPOSITION
|
|---|
| 69 | ;
|
|---|
| 70 | D EDIT G END:$D(DUOUT) I $D(SDWLERR) G END:SDWLERR
|
|---|
| 71 | W !,"*** Patient has been removed from Wait List. ***"
|
|---|
| 72 | K DIR,DIE,DR,DIC
|
|---|
| 73 | S DIR(0)="E" D ^DIR I $D(DUOUT) G END
|
|---|
| 74 | D END G EN
|
|---|
| 75 | ;
|
|---|
| 76 | Q
|
|---|
| 77 | PAT ;PATIENT LOOK-UP
|
|---|
| 78 | ;
|
|---|
| 79 | S DIC(0)="EMNAQ",DIC=409.3 D ^DIC S (SDWLDFN,DFN)=$P(Y,U,2) G PAT1:DFN<0
|
|---|
| 80 | G PAT1:DFN=""
|
|---|
| 81 | S SDWLNAM=$$GET1^DIQ(2,DFN_",",.01)
|
|---|
| 82 | S X=$$GET1^DIQ(2,DFN_",",".351") I X'="" W !!,*7,"PATIENT'S DATE OF DEATH HAS BEEN RECORDED" ;SD*5.3*454 allow user to disposition deceased patient
|
|---|
| 83 | D 1^VADPT
|
|---|
| 84 | PAT1 Q
|
|---|
| 85 | ;
|
|---|
| 86 | DIS ;DISPLAY DATA FOR PATIENT
|
|---|
| 87 | ;
|
|---|
| 88 | S SDWLDISC="",SDWLCN=0,SDWLHDR="Wait List Disposition"
|
|---|
| 89 | D EN^SDWLD(SDWLDFN,VA("PID"),VADM(1))
|
|---|
| 90 | K VADM,VAIN,VA,SDWLDISC
|
|---|
| 91 | Q
|
|---|
| 92 | GETDATA ;PATIENT DATA RETRIEVAL
|
|---|
| 93 | ;
|
|---|
| 94 | S SDWLDATA=$G(^SDWL(409.3,SDWLDA,0))
|
|---|
| 95 | S SDWLIN=$P(SDWLDATA,U,3),SDWLCL=+$P(SDWLDATA,U,4),SDWLTY=$P(SDWLDATA,U,5),SDWLST=$P(SDWLDATA,U,6)
|
|---|
| 96 | 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)
|
|---|
| 97 | S SDWLPROV=$P(SDWLDATA,U,12),SDWLDAPT=$P(SDWLDATA,U,16),SDWLST=$P(SDWLDATA,U,17),SDWLDUZ=DUZ,SDWLEDT=DT
|
|---|
| 98 | S SDWLSCL="" I SDWLSC S SDWLSCL=+$P(^SDWL(409.32,SDWLSC,0),U,1)
|
|---|
| 99 | I $D(^SDWL(409.3,SDWLDA,"DIS")) S SDWLDISP=$P(^SDWL(409.3,SDWLDA,"DIS"),U,3)
|
|---|
| 100 | Q
|
|---|
| 101 | EDIT ;ENTER/EDIT DISPOSITION
|
|---|
| 102 | ;
|
|---|
| 103 | S SDWLDUZ=DUZ,SDWLERR=0 N DIR,DR,DIE,DIC,DA
|
|---|
| 104 | I $D(SDWLDISP) S DIR("B")=$$EXTERNAL^DILFD(409.3,21,,SDWLDISP)
|
|---|
| 105 | S DIR(0)="SO^D:DEATH;NC:REMOVED/NON-VA CARE;SA:REMOVED/SCHEDULED-ASSIGNED;CC:REMOVED/VA CONTRACT CARE;NN:REMOVED/NO LONGER NECESSARY;ER:ENTERED IN ERROR;CL:CLINIC CHANGE^"
|
|---|
| 106 | S DIR("L",1)="Disposition Reason:",DIR("L",2)="",DIR("L",3)="D DEATH",DIR("L",4)="NC REMOVED/NON-VA CARE",DIR("L",5)="SA REMOVED/SCHEDULED-ASSIGNED"
|
|---|
| 107 | S DIR("L",6)="CC REMOVED/VA CONTRACT CARE",DIR("L",7)="NN REMOVED/NO LONGER NECESSARY",DIR("L")="ER ENTERED IN ERROR"
|
|---|
| 108 | S:SDWLTY=4 DIR("L",8)="CL CLINIC CHANGE"
|
|---|
| 109 | D ^DIR
|
|---|
| 110 | I X="" S DUOUT=1 Q
|
|---|
| 111 | I X="^" S DUOUT=1 Q
|
|---|
| 112 | ;S SDWLDISP=$S(X["D":"D",X["d":"D",X["NC":"NC",X["nc":"NC",X["SA":"SA",X["sa":"SA",X["CC":"CC",X["cc":"CC",X["NN":"NN",X["nn":"NN",X["ER":"ER",X["er":"ER",1:0)
|
|---|
| 113 | ;I SDWLDISP=0 S SDWLERR=1
|
|---|
| 114 | S SDWLDISP=$TR(X,"acdelnrst","ACDELNRST") S:"^D^NC^SA^CC^NN^ER^TR^"_$S(SDWLTY=4:"CL^",1:"")'[("^"_SDWLDISP_"^") SDWLERR=1
|
|---|
| 115 | I SDWLERR W *7,"Invalid Entry" G EDIT
|
|---|
| 116 | I SDWLDISP="SA" I "3,4"[SDWLTY D PKAPP(SDWLDA,SDWLTY,.SDWLDATA) Q ; QUIT OR NOT?
|
|---|
| 117 | I SDWLDISP="CL" S SDWLERR=$$EN^SDWLE7 Q:SDWLERR ; OG ; 446
|
|---|
| 118 | S DIE("NO^")="NO EDITING"
|
|---|
| 119 | S DIE="^SDWL(409.3,",DA=SDWLDA,DR="21////^S X=SDWLDISP" D ^DIE
|
|---|
| 120 | S DR="19////^S X=DT" D ^DIE
|
|---|
| 121 | S DR="20////^S X=SDWLDUZ" D ^DIE
|
|---|
| 122 | S DR="23////^S X=""C""" D ^DIE
|
|---|
| 123 | I SDWLSCL K:$D(^SDWL(409.3,"SC",SDWLSCL,SDWLDA)) ^SDWL(409.3,"SC",SDWLSCL,SDWLDA)
|
|---|
| 124 | I SDWLSS K:$D(^SDWL(409.3,"SS",SDWLDFN,SDWLSS,SDWLDA)) ^SDWL(409.3,"SS",SDWLDFN,SDWLSS,SDWLDA)
|
|---|
| 125 | ; OG ; SD*5.3*446 Inter-facility transfer.
|
|---|
| 126 | D DIS^SDWLE6(SDWLDA)
|
|---|
| 127 | Q
|
|---|
| 128 | PKAPP(SDWLDA,SDWLTY,SDWLDATA) ;identify appointemnt to close with
|
|---|
| 129 | ;SDWLDA -ien OF 409.3 to be closed
|
|---|
| 130 | ;SDWLTY - type of EWL entry
|
|---|
| 131 | ;SDWLDATA - 0 node of SDWLDA
|
|---|
| 132 | N SDCL,SDSP,SDORG,SDPCL,SDPSP S (SDCL,SDSP)="" N PROC S PROC=1
|
|---|
| 133 | S SDPCL=$$GET1^DIQ(409.3,SDWLDA_",",8,"I"),SDPSP=$$GET1^DIQ(409.3,SDWLDA_",",7,"I")
|
|---|
| 134 | I SDWLTY=4 S SDCL=$$GET1^DIQ(409.32,SDPCL_",",.01,"I")
|
|---|
| 135 | I SDWLTY=3 S SDSP=$$GET1^DIQ(409.31,SDPSP_",",.01,"I")
|
|---|
| 136 | S SDORG=$$GET1^DIQ(409.3,SDWLDA_",",1,"I")
|
|---|
| 137 | ;display app/encounters
|
|---|
| 138 | N SDDS,SDAP S SDDS=$$CHKENC^SDWLQSC1(DFN,SDORG,SDCL,SDSP,PROC)
|
|---|
| 139 | I SDWLDISP="SA" D
|
|---|
| 140 | .I $O(^TMP($J,"APPT",""))=$O(^TMP($J,"APPT",""),-1) S SDAP=$O(^TMP($J,"APPT","")) D Q
|
|---|
| 141 | ..Q:SDAP=""
|
|---|
| 142 | ..D APPTD^SDWLEVAL D SING(SDWLDA,SDWLTY,SDWLDATA)
|
|---|
| 143 | .I $O(^TMP($J,"APPT",""))'=$O(^TMP($J,"APPT",""),-1) D APPTD^SDWLEVAL D I SDAP="^" W !,"Disposition canceled by user",! Q
|
|---|
| 144 | ..W ! K DIR,X
|
|---|
| 145 | ..N STR,SS,SDA S SDA=$O(^TMP($J,"APPT",""),-1) I SDA=1 S DIR("B")=1
|
|---|
| 146 | ..S DIR(0)="N^1:"_SDA S DIR("A")="Select appt for Removal Reason or '^' to Quit>",DIR("?")="Select Appointment to close with the open EWL."
|
|---|
| 147 | ..D ^DIR
|
|---|
| 148 | ..S SDAP=X Q:X="^"!'X D SING(SDWLDA,SDWLTY,SDWLDATA)
|
|---|
| 149 | Q:SDAP="^" ;should we allow to quit or to proceed without filing an appointment?
|
|---|
| 150 | S DIE="^SDWL(409.3,",DA=SDWLDA,DR="21////^S X=SDWLDISP" D ^DIE
|
|---|
| 151 | S DR="19////^S X=DT" D ^DIE
|
|---|
| 152 | S DR="20////^S X=SDWLDUZ" D ^DIE
|
|---|
| 153 | S DR="23////^S X=""C""" D ^DIE
|
|---|
| 154 | Q
|
|---|
| 155 | SING(SDWLDA,SDWLTY,SDWLDATA) ;called for filing with appointment if any
|
|---|
| 156 | S DIE="^SDWL(409.3,",DA=SDWLDA,DR="21////^S X=SDWLDISP" D ^DIE
|
|---|
| 157 | S DR="19////^S X=DT" D ^DIE
|
|---|
| 158 | S DR="20////^S X=SDWLDUZ" D ^DIE
|
|---|
| 159 | S DR="23////^S X=""C""" D ^DIE
|
|---|
| 160 | ;if "SA" update with appoint data
|
|---|
| 161 | ;get appt data to file (for a particular appt #)
|
|---|
| 162 | I SDWLDISP="SA" N SDA D DATP^SDWLEVAL(SDAP,.SDA) D
|
|---|
| 163 | .I $D(SDA) S DIE="^SDWL(409.3,",DA=SDWLDA D
|
|---|
| 164 | ..S DR="13////"_SDA(1)_";13.1////"_DT_";13.2////"_SDA(2)_";13.3////"_SDA(15)_";13.4////"_SDA(13)_";13.5////"_SDA(14)_";13.6////"_SDA(16)_";13.8////"_SDA(3)_";13.7////"_DUZ
|
|---|
| 165 | ..D ^DIE
|
|---|
| 166 | N SDWLSCL,SDWLSS,SDWLDFN
|
|---|
| 167 | S SDWLSCL=$P(SDWLDATA,U,9)
|
|---|
| 168 | ;S SDWLSCL=$P($G(^TMP($J,"SDWLPL",SDC)),U,9)
|
|---|
| 169 | S SDWLSS=$P(SDWLDATA,U,8)
|
|---|
| 170 | ;S SDWLSS=$P($G(^TMP($J,"SDWLPL",SDC)),U,10)
|
|---|
| 171 | I SDWLSCL K:$D(^SDWL(409.3,"SC",SDWLSCL,SDWLDA)) ^SDWL(409.3,"SC",SDWLSCL,SDWLDA)
|
|---|
| 172 | S SDWLDFN=$P($G(^TMP($J,"APPT",1)),U,4)
|
|---|
| 173 | I SDWLSS,SDWLDFN K:$D(^SDWL(409.3,"SS",SDWLDFN,SDWLSS,SDWLDA)) ^SDWL(409.3,"SS",SDWLDFN,SDWLSS,SDWLDA)
|
|---|
| 174 | Q
|
|---|
| 175 | HD ;HEADER
|
|---|
| 176 | ;
|
|---|
| 177 | W:$D(IOF) @IOF W !!,?80-$L("Wait List - Disposition Patient")\2,"Wait List - Disposition Patient",!!
|
|---|
| 178 | ;
|
|---|
| 179 | END ;QUIT OPTION
|
|---|
| 180 | K DIC,DIR,DR,DIE,SDWLDFN,DUOUT,SDWLSCL
|
|---|
| 181 | K SDWLCL,SDWSLCN,SDWLDA,SDWLDAPT,SDWLDATA,SDWLDFN,SDWLDISP,SDWLDUZ,SDWLEDT,SDWLERR,SDWLIN,SDWLNAM,SDWLOP,SDWLPRI
|
|---|
| 182 | K SDWLPROV,SDWLPS,SDWLRB,SDWLSC,SDWLSP,SDWLSS,SDWLST,SDWLTY,SDWLY,X,Y,SDWLHDR
|
|---|
| 183 | Q
|
|---|
