SDWLMR ;;IOFO BAY PINES/TEH - WAIT LIST - DISPOSITION WAIT LIST ENTRY;06/12/2002 ; 20 Aug 2002 2:10 PM
;;5.3;scheduling;**263**;AUG 13 1993
;
;
;******************************************************************
; CHANGE LOG
;
; DATE PATCH DESCRIPTION
; ---- ----- -----------
;
;
;
;
;
;
EN ;
;OPTION HEADER
N SDWLDA,SDWLDFN,SDWLCN,SDWLPS,SDWLY
;
D HD
;
;PATIENT LOOK-UP FROM WAIT LIST PATIENT FILE (^SDWL(409.3,IEN,0).
;
D PAT G END:'$D(SDWLDA),END:'$D(SDWLDFN)
;
;DISPLAY PATIENT DATA FROM ^SDWL(409.3,IEN,0).
;
D DIS
;
;PROMPT USER FOR MEDICAL REVIEW ENTRY
;
S SDWLPS=$S(SDWLCN>1:1,SDWLCN=1:2,1:1)
I SDWLPS=1 S DIR(0)="FOA^^" S DIR("A")="Select Wait List (1-"_SDWLCN_")? "
I SDWLPS=2 S DIR(0)="FOA^^" S DIR("A")="Edit this 'Entry'? 1// "
W ! D ^DIR S SDWLY=Y W !
I SDWLPS=2,'SDWLY S SDWLY=1
I SDWLPS=1!(SDWLPS=2) I SDWLY?1N.N D
.;
.;CHECK FOR VALID ENTRY
.;
.I '$D(^TMP("SDWLD",$J,SDWLDFN,+SDWLY)) W !,"Invalid Entry " Q
.S SDWLDA=$P($G(^TMP("SDWLD",$J,SDWLDFN,+SDWLY)),"~",2)
.;
.;LOCK DATA FILE
.;
.L +^SDWL(409.3,SDWLDA):5 I '$T W !,"Another Terminal is Editting this Entry! Try Later." S DUOUT=1
I $D(DUOUT) Q
;
;GET PATIENT DATA FROM ^SDWL(409.3,IEN,0).
;
D GETDATA
;
;ADVANCED DISPLAY OF PATIENT FIELDS IN ^SDWL(409.3,IEN,0)
;
;FIELD DESCRIPTION REQUIRED
;----- ----------- --------
;
; 13 MEDICAL REVIEW COMPLETED
; 14 MEDICAL REVIEW DATE
; 15 MEDICAL REVIEW USER
;
D DISP
;
;ENTER DISPOSITION
;
D EDIT
L -^SDWL(409.3,SDWLDA)
;
Q
PAT ;PATIENT LOOK-UP
;
S DIC(0)="AQEMNZ",DIC="^SDWL(409.3,",DIC("A")="ENTER WAIT LIST PATIENT NAME: " D ^DIC
G PATEND:Y<0
N DFN S (SDWLDFN,DFN)=$P(Y,U,2),SDWLDA=$P(Y,U,1)
D 1^VADPT
PATEND Q
;
DIS ;DISPLAY DATA FOR PATIENT
;
D EN^SDWLD(SDWLDFN,VA("PID"),VADM(1))
Q
GETDATA ;PATIENT DATA RETRIEVAL
;
S SDWLDATA=$G(^SDWL(409.3,SDWLDA,0))
S SDWLIN=$P(SDWLDATA,U,3),SDWLCL=+$P(SDWLDATA,U,4),SDWLTY=$P(SDWLDATA,U,5),SDWLST=$P(SDWLDATA,U,6)
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)
I SDWLSP'="" S SDWLTYN=SDWLSP
I SDWLSS'="" S SDWLTYN=SDWLSS
I SDWLSC'="" S SDWLTYN=SDWLSC
I SDWLST'="" S SDWLTYN=SDWLST
S SDWLPROV=$P(SDWLDATA,U,12),SDWLDAPT=$P(SDWLDATA,U,16),SDWLST=$P(SDWLDATA,U,17),SDWLDUZ=DUZ,SDWLEDT=DT
Q
DISP ;DISPLAY
W !,"Wait List: ",$$EXTERNAL^DILFD(409.3,4,,SDWLTY),?40,"Date Entered: ",$$GET1^DIQ(409.3,SDWLDA,14,,,)
W !,"Priority: ",$$GET1^DIQ(409.3,SDWLDA,SDWLPRI,,,),?20,"Institution: ",$$GET1^DIQ(409.3,SDWLDA,SDWLIN,,,)
W ?40,"Entered By: ",$$GET1^DIQ(409.3,SDWLDA,9,,,)
W !,"Requesting Provider: ",$$GET1^DIQ(409.3,SDWLDA,15,,,),?40,"Date Desired: ",$$GET1^DIQ(409.3,SDWLDA,16,,,)
Q
;
EDIT ;ENTER/EDIT DISPOSITION
;
S DIE="^SDWL(409.3,",DA=SDWLDA,DR="13Medical Record Documented " D ^DIE
S DR="14Date Medical Review Completed " D ^DIE
S DR="15Completed By " D ^DIE
Q
;
HD ;HEADER
;
W:$D(IOF) @IOF W !!,?80-$L("WAIT LIST - DISPOSITION PATIENT")\2,"WAIT LIST - DISPOSITION PATIENT",!!
;
END ;QUIT OPTION
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLMR 3466 printed Apr 09, 2024@21:52:37 Page 2
SDWLMR ;;IOFO BAY PINES/TEH - WAIT LIST - DISPOSITION WAIT LIST ENTRY;06/12/2002 ; 20 Aug 2002 2:10 PM
+1 ;;5.3;scheduling;**263**;AUG 13 1993
+2 ;
+3 ;
+4 ;******************************************************************
+5 ; CHANGE LOG
+6 ;
+7 ; DATE PATCH DESCRIPTION
+8 ; ---- ----- -----------
+9 ;
+10 ;
+11 ;
+12 ;
+13 ;
+14 ;
EN ;
+1 ;OPTION HEADER
+2 NEW SDWLDA,SDWLDFN,SDWLCN,SDWLPS,SDWLY
+3 ;
+4 DO HD
+5 ;
+6 ;PATIENT LOOK-UP FROM WAIT LIST PATIENT FILE (^SDWL(409.3,IEN,0).
+7 ;
+8 DO PAT
if '$DATA(SDWLDA)
GOTO END
if '$DATA(SDWLDFN)
GOTO END
+9 ;
+10 ;DISPLAY PATIENT DATA FROM ^SDWL(409.3,IEN,0).
+11 ;
+12 DO DIS
+13 ;
+14 ;PROMPT USER FOR MEDICAL REVIEW ENTRY
+15 ;
+16 SET SDWLPS=$SELECT(SDWLCN>1:1,SDWLCN=1:2,1:1)
+17 IF SDWLPS=1
SET DIR(0)="FOA^^"
SET DIR("A")="Select Wait List (1-"_SDWLCN_")? "
+18 IF SDWLPS=2
SET DIR(0)="FOA^^"
SET DIR("A")="Edit this 'Entry'? 1// "
+19 WRITE !
DO ^DIR
SET SDWLY=Y
WRITE !
+20 IF SDWLPS=2
IF 'SDWLY
SET SDWLY=1
+21 IF SDWLPS=1!(SDWLPS=2)
IF SDWLY?1N.N
Begin DoDot:1
+22 ;
+23 ;CHECK FOR VALID ENTRY
+24 ;
+25 IF '$DATA(^TMP("SDWLD",$JOB,SDWLDFN,+SDWLY))
WRITE !,"Invalid Entry "
QUIT
+26 SET SDWLDA=$PIECE($GET(^TMP("SDWLD",$JOB,SDWLDFN,+SDWLY)),"~",2)
+27 ;
+28 ;LOCK DATA FILE
+29 ;
+30 LOCK +^SDWL(409.3,SDWLDA):5
IF '$TEST
WRITE !,"Another Terminal is Editting this Entry! Try Later."
SET DUOUT=1
End DoDot:1
+31 IF $DATA(DUOUT)
QUIT
+32 ;
+33 ;GET PATIENT DATA FROM ^SDWL(409.3,IEN,0).
+34 ;
+35 DO GETDATA
+36 ;
+37 ;ADVANCED DISPLAY OF PATIENT FIELDS IN ^SDWL(409.3,IEN,0)
+38 ;
+39 ;FIELD DESCRIPTION REQUIRED
+40 ;----- ----------- --------
+41 ;
+42 ; 13 MEDICAL REVIEW COMPLETED
+43 ; 14 MEDICAL REVIEW DATE
+44 ; 15 MEDICAL REVIEW USER
+45 ;
+46 DO DISP
+47 ;
+48 ;ENTER DISPOSITION
+49 ;
+50 DO EDIT
+51 LOCK -^SDWL(409.3,SDWLDA)
+52 ;
+53 QUIT
PAT ;PATIENT LOOK-UP
+1 ;
+2 SET DIC(0)="AQEMNZ"
SET DIC="^SDWL(409.3,"
SET DIC("A")="ENTER WAIT LIST PATIENT NAME: "
DO ^DIC
+3 if Y<0
GOTO PATEND
+4 NEW DFN
SET (SDWLDFN,DFN)=$PIECE(Y,U,2)
SET SDWLDA=$PIECE(Y,U,1)
+5 DO 1^VADPT
PATEND QUIT
+1 ;
DIS ;DISPLAY DATA FOR PATIENT
+1 ;
+2 DO EN^SDWLD(SDWLDFN,VA("PID"),VADM(1))
+3 QUIT
GETDATA ;PATIENT DATA RETRIEVAL
+1 ;
+2 SET SDWLDATA=$GET(^SDWL(409.3,SDWLDA,0))
+3 SET SDWLIN=$PIECE(SDWLDATA,U,3)
SET SDWLCL=+$PIECE(SDWLDATA,U,4)
SET SDWLTY=$PIECE(SDWLDATA,U,5)
SET SDWLST=$PIECE(SDWLDATA,U,6)
+4 SET SDWLSP=$PIECE(SDWLDATA,U,7)
SET SDWLSS=$PIECE(SDWLDATA,U,8)
SET SDWLSC=$PIECE(SDWLDATA,U,9)
SET SDWLPRI=$PIECE(SDWLDATA,U,10)
SET SDWLRB=$PIECE(SDWLDATA,U,11)
+5 IF SDWLSP'=""
SET SDWLTYN=SDWLSP
+6 IF SDWLSS'=""
SET SDWLTYN=SDWLSS
+7 IF SDWLSC'=""
SET SDWLTYN=SDWLSC
+8 IF SDWLST'=""
SET SDWLTYN=SDWLST
+9 SET SDWLPROV=$PIECE(SDWLDATA,U,12)
SET SDWLDAPT=$PIECE(SDWLDATA,U,16)
SET SDWLST=$PIECE(SDWLDATA,U,17)
SET SDWLDUZ=DUZ
SET SDWLEDT=DT
+10 QUIT
DISP ;DISPLAY
+1 WRITE !,"Wait List: ",$$EXTERNAL^DILFD(409.3,4,,SDWLTY),?40,"Date Entered: ",$$GET1^DIQ(409.3,SDWLDA,14,,,)
+2 WRITE !,"Priority: ",$$GET1^DIQ(409.3,SDWLDA,SDWLPRI,,,),?20,"Institution: ",$$GET1^DIQ(409.3,SDWLDA,SDWLIN,,,)
+3 WRITE ?40,"Entered By: ",$$GET1^DIQ(409.3,SDWLDA,9,,,)
+4 WRITE !,"Requesting Provider: ",$$GET1^DIQ(409.3,SDWLDA,15,,,),?40,"Date Desired: ",$$GET1^DIQ(409.3,SDWLDA,16,,,)
+5 QUIT
+6 ;
EDIT ;ENTER/EDIT DISPOSITION
+1 ;
+2 SET DIE="^SDWL(409.3,"
SET DA=SDWLDA
SET DR="13Medical Record Documented "
DO ^DIE
+3 SET DR="14Date Medical Review Completed "
DO ^DIE
+4 SET DR="15Completed By "
DO ^DIE
+5 QUIT
+6 ;
HD ;HEADER
+1 ;
+2 if $DATA(IOF)
WRITE @IOF
WRITE !!,?80-$LENGTH("WAIT LIST - DISPOSITION PATIENT")\2,"WAIT LIST - DISPOSITION PATIENT",!!
+3 ;
END ;QUIT OPTION
+1 QUIT
