| 1 | SDWLEVAL ;;IOFO BAY PINES/ESW - WAIT LIST - DISPOSITION AFTER APPOINTMENT(S) ENTRY;06/12/2002 ; 5/23/05 4:47pm ; Compiled April 20, 2006 17:36:31 ; Compiled May 2, 2006 10:03:55 ; Compiled May 1, 2007 15:18:38
|
|---|
| 2 | ;;5.3;Scheduling;**327,471,446**;AUG 13 1993;Build 77
|
|---|
| 3 | ;Evaluate appt for optional disposition
|
|---|
| 4 | ;called from SDMM, SDMM1, SDM1A, SDAM2 ; replaced SDWLR
|
|---|
| 5 | ;
|
|---|
| 6 | EN(DFN,SDYN) ;evaluation if patient is on EWL
|
|---|
| 7 | ; SDYN passed by reference
|
|---|
| 8 | ;output: SDYN=0 - no open entries in EWL
|
|---|
| 9 | ; SDYN=1 - at least one open entry in EWL
|
|---|
| 10 | S SDYN=0,SDYN(1)=""
|
|---|
| 11 | I '$D(DFN)!(DFN'?1.N) S SDYN(1)="Patient's DFN not passed." Q
|
|---|
| 12 | I $D(DFN),'$D(^SDWL(409.3,"B",DFN)) S SDYN(1)="This patient is not on EWL." Q
|
|---|
| 13 | S SDWLDA="" F S SDWLDA=$O(^SDWL(409.3,"B",DFN,SDWLDA)) Q:SDWLDA="" D Q:SDYN=1
|
|---|
| 14 | .I $P($G(^SDWL(409.3,SDWLDA,0)),"^",17)="O" S SDYN=1,SDYN(1)="Patient has open Wait List entries."
|
|---|
| 15 | I SDYN=0 S SDYN(1)="Patient has no open Wait List entries."
|
|---|
| 16 | Q
|
|---|
| 17 | EWLANS(SDCONT) ;display EWL OPEN entries
|
|---|
| 18 | ;check if to continue with EWL open entries
|
|---|
| 19 | S SDCONT=0
|
|---|
| 20 | N X,DIR,Y
|
|---|
| 21 | S DIR("B")="NO"
|
|---|
| 22 | S DIR("A")="Do you want to display open Wait list entries (Yes/No)?",DIR(0)="Y"
|
|---|
| 23 | S DIR("?")="Do you want to review open EWL entries for Dispositioning?"
|
|---|
| 24 | D ^DIR
|
|---|
| 25 | I Y S SDCONT=1
|
|---|
| 26 | Q
|
|---|
| 27 | ASKREM ;prompt user for record for dispositioning
|
|---|
| 28 | S SDDIS=0 ; flag indicating disposition
|
|---|
| 29 | W ! N X,DIR,Y
|
|---|
| 30 | S DIR("B")="NO"
|
|---|
| 31 | S DIR("A")="DO YOU WISH TO REMOVE ANY ENTRY FROM LIST (Yes/No)? ",DIR(0)="Y"
|
|---|
| 32 | S DIR("?")="To disposition any entry based on scheduled appointments."
|
|---|
| 33 | D ^DIR
|
|---|
| 34 | I Y S SDDIS=1
|
|---|
| 35 | D ANSW(SDDIS)
|
|---|
| 36 | Q
|
|---|
| 37 | ANSW(SDDIS,SDR) ;
|
|---|
| 38 | ;SDDIS=0 - select entries not to disposition
|
|---|
| 39 | ;SDDIS=1 - select entries to disposition
|
|---|
| 40 | N DIR,X I '$D(SDR) S SDR=0
|
|---|
| 41 | W !
|
|---|
| 42 | N STR,SS,SDCB S SDC=$O(^TMP($J,"SDWLPL",""),-1),SDCB=$O(^TMP($J,"SDWLPL",""))
|
|---|
| 43 | ;I SDC=SDCB S DIR("B")=SDC
|
|---|
| 44 | ;E S DIR("B")=SDCB_"-"_SDC
|
|---|
| 45 | S DIR(0)="L^"_SDCB_":"_SDC S DIR("A")="You must select one of the above EWL entries and then enter a non-removal reason: ",DIR("?")="Enter number(s) or range of displayed Wait List entries."
|
|---|
| 46 | I SDDIS S DIR("A")="Select one of the above open EWL entries to close with an appointment or enter '^' to continue>"
|
|---|
| 47 | D ^DIR
|
|---|
| 48 | N SDAN S SDAN=X I SDAN="^" Q
|
|---|
| 49 | I SDAN["-" D
|
|---|
| 50 | .N SXB,SXE
|
|---|
| 51 | .S SXB=$P(SDAN,"-"),SXE=$P(SDAN,"-",2) N SDC F SDC=SXB:1:SXE I $D(^TMP($J,"SDWLPL",SDC)) S SDWLDA=+^TMP($J,"SDWLPL",SDC) D
|
|---|
| 52 | ..;LOCK
|
|---|
| 53 | ..L +^SDWL(409.3,SDWLDA):5 I '$T W !,"Another User is Editing this Entry. Try Later." Q
|
|---|
| 54 | ..I 'SDDIS N SDR F D DISPO(SDWLDA,SDC,.SDR) Q:SDR
|
|---|
| 55 | ..I SDDIS D GETDATA(SDWLDA) D DISEND(SDWLDA,SDC) S SDR=1
|
|---|
| 56 | ..L
|
|---|
| 57 | I SDAN[","!(SDAN?1N) D
|
|---|
| 58 | .N FF S FF=SDAN N GG,SDC F GG=1:1 S SDC=$P(FF,",",GG) Q:SDC="" I $D(^TMP($J,"SDWLPL",SDC)) S SDWLDA=+^TMP($J,"SDWLPL",SDC) D
|
|---|
| 59 | ..;LOCK
|
|---|
| 60 | ..L +^SDWL(409.3,SDWLDA):5 I '$T W !,"Another User is Editing this Entry. Try Later." Q
|
|---|
| 61 | ..I 'SDDIS N SDR F D DISPO(SDWLDA,SDC,.SDR) Q:SDR
|
|---|
| 62 | ..I SDDIS D GETDATA(SDWLDA) D DISEND(SDWLDA,SDC) S SDR=1
|
|---|
| 63 | ..L
|
|---|
| 64 | Q
|
|---|
| 65 | DISEND(SDWLDA,SDC) ;display and disposition
|
|---|
| 66 | ;SDWLDA - IEN of 409.3
|
|---|
| 67 | N DUOUT D EDIT(SDWLDA,SDC,.SDWLERR) Q:$G(DUOUT) I SDWLERR Q
|
|---|
| 68 | W !!,"*** Patient has been removed from Wait List ***",!
|
|---|
| 69 | K ^TMP($J,"SDWLPL",SDC)
|
|---|
| 70 | K DIR,DIE,DR,DIC
|
|---|
| 71 | Q
|
|---|
| 72 | GETDATA(SDWLDA) ;retrieval data
|
|---|
| 73 | N SDWLCL,SDWLDAPT,SDWLDATA,SDWLDISP,SDWLDUZ,SDWLEDT,SDWLIN,SDWLPRI,SDWLPROV,SDWLRB,SDWLSC,SDWLSP,SDWLST,SDWLTY
|
|---|
| 74 | S SDWLDATA=$G(^SDWL(409.3,SDWLDA,0))
|
|---|
| 75 | S SDWLIN=$P(SDWLDATA,U,3),SDWLCL=+$P(SDWLDATA,U,4),SDWLTY=$P(SDWLDATA,U,5),SDWLST=$P(SDWLDATA,U,6)
|
|---|
| 76 | 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)
|
|---|
| 77 | S SDWLPROV=$P(SDWLDATA,U,12),SDWLDAPT=$P(SDWLDATA,U,16),SDWLST=$P(SDWLDATA,U,17),SDWLDUZ=DUZ,SDWLEDT=DT
|
|---|
| 78 | S SDWLSCL="" I SDWLSC S SDWLSCL=+$P(^SDWL(409.32,SDWLSC,0),U,1)
|
|---|
| 79 | I $D(^SDWL(409.3,SDWLDA,"DIS")) S SDWLDISP=$P(^SDWL(409.3,SDWLDA,"DIS"),U,3)
|
|---|
| 80 | Q
|
|---|
| 81 | EDIT(SDWLDA,SDC,SDWLERR) ;ENTER/EDIT DISPOSITION
|
|---|
| 82 | ;SDWLDA -IEN of selected 409.3 entry
|
|---|
| 83 | ;SDWLERR - called by a reference
|
|---|
| 84 | ;SDC - sequential number in ^TMP($J,"SDWLPL",SDC
|
|---|
| 85 | S SDWLDUZ=DUZ,SDWLERR=0 S SDWLDISP="SA" D EDITSA Q ;N DIR,DR,DIE,DIC
|
|---|
| 86 | EDITSA I SDWLDISP="SA" D
|
|---|
| 87 | .I $O(^TMP($J,"APPT",""))=$O(^TMP($J,"APPT",""),-1) S SDAP=$O(^TMP($J,"APPT","")) Q
|
|---|
| 88 | .I $O(^TMP($J,"APPT",""))'=$O(^TMP($J,"APPT",""),-1) D APPTD D I SDAP="^" W !,"Disposition canceled by user",! Q
|
|---|
| 89 | ..W ! K DIR,X
|
|---|
| 90 | ..N STR,SS,SDA S SDA=$O(^TMP($J,"APPT",""),-1) I SDA=1 S DIR("B")=1
|
|---|
| 91 | ..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."
|
|---|
| 92 | ..D ^DIR
|
|---|
| 93 | ..S SDAP=X
|
|---|
| 94 | S DIE="^SDWL(409.3,",DA=SDWLDA,DR="21////^S X=SDWLDISP" D ^DIE
|
|---|
| 95 | S DR="19////^S X=DT" D ^DIE
|
|---|
| 96 | S DR="20////^S X=SDWLDUZ" D ^DIE
|
|---|
| 97 | S DR="23////^S X=""C""" D ^DIE
|
|---|
| 98 | ;if "SA" update with appoint data
|
|---|
| 99 | ;get appt data to file (for a particular appt #)
|
|---|
| 100 | I SDWLDISP="SA" N SDA D DATP(SDAP,.SDA) D
|
|---|
| 101 | .I $D(SDA) S DIE="^SDWL(409.3,",DA=SDWLDA D
|
|---|
| 102 | ..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
|
|---|
| 103 | ..D ^DIE
|
|---|
| 104 | N SDWLSCL,SDWLSS,SDWLDFN
|
|---|
| 105 | S SDWLSCL=$P($G(^TMP($J,"SDWLPL",SDC)),U,9)
|
|---|
| 106 | S SDWLSS=$P($G(^TMP($J,"SDWLPL",SDC)),U,10)
|
|---|
| 107 | I SDWLSCL K:$D(^SDWL(409.3,"SC",SDWLSCL,SDWLDA)) ^SDWL(409.3,"SC",SDWLSCL,SDWLDA)
|
|---|
| 108 | S SDWLDFN=$P($G(^TMP($J,"APPT",1)),U,4)
|
|---|
| 109 | I SDWLSS,SDWLDFN K:$D(^SDWL(409.3,"SS",SDWLDFN,SDWLSS,SDWLDA)) ^SDWL(409.3,"SS",SDWLDFN,SDWLSS,SDWLDA)
|
|---|
| 110 | Q
|
|---|
| 111 | DISPO(SDWLDA,SDC,SDR) ;
|
|---|
| 112 | ;SDWLDA - IEN of 409.3
|
|---|
| 113 | ;SDC - seq in ^TMP($J,"SDWLPL",SDC
|
|---|
| 114 | ;out SDR - NON REMOVAL:
|
|---|
| 115 | ; 1 entered
|
|---|
| 116 | ; 0 not entered
|
|---|
| 117 | K DIR,X S SDR=0
|
|---|
| 118 | S DIR(0)="SM^1:APPOINTMENT CRITERIA NOT MET;2:PATIENT WANTS ANOTHER APPOINTMENT;3:PROVIDER WANTS ANOTHER APPOINTMENT;4:OTHER"
|
|---|
| 119 | S DIR("L",1)="SELECT ONE OF THE FOLLOWING REASONS FOR # "_SDC_":",DIR("L",2)=""
|
|---|
| 120 | S DIR("L",3)="1. APPOINTMENT CRITERIA NOT MET",DIR("L",4)="2. PATIENT WANTS ANOTHER APPOINTMENT"
|
|---|
| 121 | S DIR("L",5)="3. PROVIDER WANTS ANOTHER APPOINTMENT",DIR("L,6")="4. OTHER"
|
|---|
| 122 | S DIR("A")="Select one of the following reasons for #: "_SDC
|
|---|
| 123 | D ^DIR
|
|---|
| 124 | S X=$E(X,1,2) S:$E(X,2)'="R" X=$E(X)
|
|---|
| 125 | S SDWLX=$S(X="a":"A",X="p":"P",X="pr":"PR",X="o":"O",X="A":"A",X="P":"P",X="PR":"PR",X="O":"O",X=1:"A",X=2:"P",X=3:"PR",X=4:"O",1:"^")
|
|---|
| 126 | I SDWLX="^" Q
|
|---|
| 127 | S SDR=1
|
|---|
| 128 | I SDWLX="O" D
|
|---|
| 129 | .S DIR(0)="FAO^^",DIR("A")="Comments: " D ^DIR Q:X["^"
|
|---|
| 130 | .S SDWLCOM=X,DA=SDWLDA,DIE="^SDWL(409.3,",DR="18.1////^S X=SDWLCOM" D ^DIE
|
|---|
| 131 | N DA S DA=SDWLDA
|
|---|
| 132 | S DIE="^SDWL(409.3,",DR="18////^S X=SDWLX" D ^DIE
|
|---|
| 133 | S DR="17////^S X=DUZ" D ^DIE
|
|---|
| 134 | S DR="16////^S X=DT" D ^DIE
|
|---|
| 135 | K SDWLERR,DIR,DR,DIE,X,SDWLX,SDWLDSS,SDWLASK,SDWLDA,SDWLCOM
|
|---|
| 136 | K ^TMP($J,"SDWLPL",SDC)
|
|---|
| 137 | Q
|
|---|
| 138 | HD ;HEADER
|
|---|
| 139 | W:$D(IOF) @IOF W !!,?80-$L("Wait List - Disposition Patient")\2,"Wait List - Disposition Patient",!!
|
|---|
| 140 | Q
|
|---|
| 141 | APPT(DFN,SD,SC) ;create appt TMP
|
|---|
| 142 | ;SD - appt date/time
|
|---|
| 143 | ;SC - clinic IEN
|
|---|
| 144 | N SDARR,SCNT
|
|---|
| 145 | S SDDIV=""
|
|---|
| 146 | S SDARR(1)=SD_";"_SD
|
|---|
| 147 | S SDARR(2)=SC
|
|---|
| 148 | S SDARR(4)=DFN
|
|---|
| 149 | S SDARR("FLDS")="1;2;3;4;10;13;14;17"
|
|---|
| 150 | N SAPP S SAPP=$$SDAPI^SDAMA301(.SDARR) D
|
|---|
| 151 | .N SDINST,SDFAC,SDINSTE
|
|---|
| 152 | .Q:'$D(^TMP($J,"SDAMA301",DFN))
|
|---|
| 153 | .S SCNT=$O(^TMP($J,"APPT",""),-1)+1
|
|---|
| 154 | .S ^TMP($J,"APPT",SCNT)=^TMP($J,"SDAMA301",DFN,SC,SD)
|
|---|
| 155 | .N SDCLIN S SDCLIN=$$CLIN^SDWLBACC(SC),SDINST=$P(SDCLIN,U),SDFAC=$P(SDCLIN,U,2),SDINSTE=$P(SDCLIN,U,3)
|
|---|
| 156 | .S $P(^TMP($J,"APPT",SCNT),"^",15)=SDINST_";"_SDINSTE
|
|---|
| 157 | .S $P(^TMP($J,"APPT",SCNT),"^",16)=SDFAC
|
|---|
| 158 | .K ^TMP($J,"SDAMA301",DFN,SC,SD)
|
|---|
| 159 | Q
|
|---|
| 160 | APPTD ;display appt
|
|---|
| 161 | ;from ^TMP($J,"APPT")
|
|---|
| 162 | N STR,SCNT
|
|---|
| 163 | Q:'$D(^TMP($J,"APPT"))
|
|---|
| 164 | S SCNT="" F S SCNT=$O(^TMP($J,"APPT",SCNT)) Q:SCNT="" D
|
|---|
| 165 | .S STR=^TMP($J,"APPT",SCNT)
|
|---|
| 166 | .N ZZ F ZZ=2,3,4,10,15 S SDD(ZZ)=$P($P(STR,"^",ZZ),";",2)
|
|---|
| 167 | .N SD S SD=$P(STR,U) D S Y=SD D D^DIQ S SDD(1)=Y ; date conv
|
|---|
| 168 | ..I SDD(3)="SCHEDULED/KEPT" S SDD(3)=";"_$S(SD<DT:"KEPT",1:"SCHEDULED")
|
|---|
| 169 | .S SDD(16)=$P(STR,U,16)
|
|---|
| 170 | .N CP,ZZ F ZZ=13,14 S CP(ZZ)=$P($P(STR,U,ZZ),";") D
|
|---|
| 171 | ..S SDD(ZZ)=""
|
|---|
| 172 | ..I CP(ZZ)>0 S SDD(ZZ)=$$GET1^DIQ(40.7,CP(ZZ)_",",.01,"I") ; stop code desc
|
|---|
| 173 | .;DISPLAY
|
|---|
| 174 | .I SCNT=1 D DPH(SCNT,.SDD)
|
|---|
| 175 | .D DPHD(SCNT,.SDD)
|
|---|
| 176 | W !
|
|---|
| 177 | Q
|
|---|
| 178 | DATP(SCNT,SDA) ;
|
|---|
| 179 | ;SDA - to return APPT array
|
|---|
| 180 | S STR=^TMP($J,"APPT",SCNT)
|
|---|
| 181 | S SDA(1)=$P(STR,U)
|
|---|
| 182 | N ZZ F ZZ=2,3,10,13,14,15 S SDA(ZZ)=$P($P(STR,"^",ZZ),";",1)
|
|---|
| 183 | S SDA(16)=$P(STR,"^",16) ;station
|
|---|
| 184 | Q
|
|---|
| 185 | DPH(SCNT,SDD) ;display appt header
|
|---|
| 186 | W !!,"Appointment(s) for: "_SDD(4) W !!?4,"Specialty: "_SDD(13),?60,"Station: ",SDD(16),!
|
|---|
| 187 | W !?3,"Appt Date/Time",?23,"Clinic",?48,"Status",?60,"Institution",! N SDL S $P(SDL,"-",79)="" W SDL,!
|
|---|
| 188 | Q
|
|---|
| 189 | DPHD(SCNT,SDD) ;
|
|---|
| 190 | W !,SCNT,?3,SDD(1),?23,$E(SDD(2),1,23),?48,$E(SDD(10),1,10),?60,SDD(15)
|
|---|
| 191 | Q
|
|---|
