SDWLE ;BPOI/TEH - WAITING LIST-ENTER/EDIT;06/12/2002
;;5.3;scheduling;**263,415,446,524,769**;08/13/93;Build 22
;
;
;******************************************************************
; CHANGE LOG
;
; DATE PATCH DESCRIPTION
; ---- ----- -----------
; 09JUN2005 446 Inter-Facility Transfer.
;
;
EN ;ENTRY POINT - INTIALIZE VARIABLES
Q ;SD*5.3*769 -EWL Decom
N DTOUT,%
I $D(SDWLOPT),SDWLOPT G OPT
I $D(SDWLLIST),SDWLLIST,$D(DFN),DFN<0 K SDWLLIST
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
K ^TMP("SDWLD",$J) D HD
D PAT G END:DFN<0
OPT Q ;S SDWLPCMM=0,SDWLERR=0 I $D(SDWLOPT),SDWLOPT D - SD*5.3*769 -EWL Decom
;.S %=2 W !,"DO YOU WISH TO PLACE THIS PATIENT ON A WAITING LIST " D YN^DICN
;.I %=-1!(%=2) S SDWLERR=1 Q
;I $D(SDWLOPT),SDWLOPT,SDWLERR Q
;S SDWLDFN=DFN
;D 1^VADPT
;S (SDWLTEM,SDWLPOS)=0
EN1 N SDWLNEW,SDWLERR,SDWLCN,SDWLWTE S SDWLNEW=0,SDWLERR=0,SDWLCN=0,SDWLWTE=0
G:$$EN^SDWLE6(SDWLDFN,.SDWLERR) EN2 ; OG ; SD*5.3*446 ; Inter-facility transfer
D DIS
I $D(^SDWL(409.3,"B",DFN)),'SDWLCN W !!,"PATIENT: ",VADM(1),?40,VA("PID")
S SDWLPS=$S(SDWLCN>1:1,SDWLCN=1:2,1:3)
I $D(SDWLOPT),SDWLOPT,SDWLPS=3 S X="Y" G ENO
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."
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."
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// "
W ! D ^DIR W ! K DIR
G END:$D(DUOUT),END:$D(DTOUT)
I SDWLPS=1 D G EN3:SDWLERR=1 I SDWLERR=2 W *7," ??" G EN1
.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
I SDWLPS=2 D G EN3:SDWLERR=1 I SDWLERR=2 W *7," ??" G EN1
.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
ENO I SDWLPS=3 D G EN3:SDWLERR=1 I SDWLERR=2 W *7," ??" G EN1
.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
I SDWLPS=1!(SDWLPS=2),X?1N.N D
.N DA,SDWLDA S (DA,SDWLDA)=$P($G(^TMP("SDWLD",$J,DFN,+X)),"~",2),SDWLEDIT=""
.;
.;LOCK DATA FILE
.;
.L +^SDWL(409.3,DA):5 I '$T W !,"ANOTHER TERMINAL IS EDITING THIS ENTRY. TRY LATER." S DUOUT=1
.I $D(DUOUT) Q
.N SDWLINNM,SDWLSTN ; OG ; This and the following six lines added for patch 415
.I $$GETTRN^SDWLIFT1(SDWLDA,.SDWLINNM,.SDWLSTN) D S DUOUT=1 Q
..N SDWLMSG,SDWLI
..S SDWLMSG(0)=1,SDWLMSG(SDWLMSG(0),0)="This entry is the subject of a transfer to "_SDWLINNM_" ("_SDWLSTN_"). Editing inhibited."
..I $L(SDWLMSG(SDWLMSG(0),0))>80 D COL80^SDWLIFT(.SDWLMSG)
..F SDWLI=1:1:SDWLMSG(0) W !,SDWLMSG(SDWLI,0)
..Q
.D EN^SDWLE10
.D EDIT W !!,"Editing is Completed" S SDWLERR=1 K SDWLEDIT
G END:SDWLERR
I SDWLPS=1!(SDWLPS=2),X?1"N".E!(X?1"n".E) D NEW,EDIT S SDWLNEW="" G EN2
I SDWLPS=3 D NEW,EDIT S SDWLNEW=""
EN2 I $D(SDWLNEW),'$D(DUOUT),'SDWLERR W !!,?15,"*** Patient has been added to Wait List ***",!
K SDWLNEW,DUOUT
;
;UNLOCK FILE AND KILL LOCAL VARIABLES
;
I $D(SDWLDA) L -^SDWL(409.3,SDWLDA)
;-exit logic
EN3 D END^SDWLE113
Q
END D END^SDWLE113
D EN^SDWLKIL
Q
;
;
PAT ;SELECT PATIENT
;
S DIC(0)="EMNZAQ",DIC=2 D ^DIC S (SDWLDFN,DFN)=$P(Y,U,1) G PAT1:DFN<0
S X=$$GET1^DIQ(2,DFN_",",".351") I X'="" W !,*7,"PATIENT'S DATE OF DEATH HAS BEEN RECORDED" G PAT
S SDWLSSN=$G(VA("PID")),SDWLNAM=$G(VA(1))
PAT1 K VADM,VAIN,VAERR,VA Q
;
DIS ;DISPLAY DATA FOR PATIENT
;
S SDWLHDR="Wait List Enter/Edit"
D EN^SDWLD(DFN,VA("PID"),VADM(1))
D PCM^SDWLE1,PCMD^SDWLE1
Q
;
NEW ;
D NEW^SDWLE11
Q
;
EDIT ;
D EN^SDWLE111 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
I SDWLTYE=4 D ED4 K DIR,DIE,DIC,DR Q
I SDWLTYE=3 D ED3 K DIR,DIE,DIC,DR Q
I SDWLTYE=2 D ED2 K DIR,DIE,DIC,DR Q
I SDWLTYE=1 D ED1 K DIR,DIE,DIC,DR Q
Q
ED1 ;-team
I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
D EN^SDWLE3 I '$D(DUOUT) D EN^SDWLE113 Q
Q
ED2 ;-position
I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
D EN^SDWLE5 I '$D(DUOUT) D EN^SDWLE113 Q
Q
ED3 ;-specialty
D EN^SDWLE2 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
D EN^SDWLE110 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
I '$D(DUOUT) D EN^SDWLE113
D END^SDWLE113
Q
ED4 ;-clinic
D EN^SDWLE4 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
D EN^SDWLE110 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
I '$D(DUOUT) D EN^SDWLE113
D END^SDWLE113
Q
;
ED5 D END^SDWLE113
Q
SB1 S X=$$GET1^DIQ(2,DFN_",",".351") I X'="" S DUOUT=""
Q
HD W:$D(IOF) @IOF W !,?80-$L("Scheduling/PCMM Enter/Edit Wait List")\2,"Scheduling/PCMM Enter/Edit Wait List",!!
I $D(DFN),DFN'="",'$D(^SDWL(409.3,"B",DFN)),$D(SDWLLIST),SDWLLIST D
.W !!,"PATIENT: ",VADM(1),?40,VA("PID")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLE 5273 printed Dec 13, 2024@03:02:22 Page 2
SDWLE ;BPOI/TEH - WAITING LIST-ENTER/EDIT;06/12/2002
+1 ;;5.3;scheduling;**263,415,446,524,769**;08/13/93;Build 22
+2 ;
+3 ;
+4 ;******************************************************************
+5 ; CHANGE LOG
+6 ;
+7 ; DATE PATCH DESCRIPTION
+8 ; ---- ----- -----------
+9 ; 09JUN2005 446 Inter-Facility Transfer.
+10 ;
+11 ;
EN ;ENTRY POINT - INTIALIZE VARIABLES
+1 ;SD*5.3*769 -EWL Decom
QUIT
+2 NEW DTOUT,%
+3 IF $DATA(SDWLOPT)
IF SDWLOPT
GOTO OPT
+4 IF $DATA(SDWLLIST)
IF SDWLLIST
IF $DATA(DFN)
IF DFN<0
KILL SDWLLIST
+5 IF $DATA(SDWLLIST)
IF SDWLLIST
IF $DATA(DFN)
IF DFN'=""
SET SDWLDFN=DFN
DO 1^VADPT
SET (SDWLTEM,SDWLPOS)=0
DO HD
DO SB1
if '$DATA(DUOUT)
GOTO EN1
WRITE !,"PATIENT: ",VADM(1),?40,VA("PID")
WRITE !,*7,"PATIENT'S DATE OF DEATH HAS BEEN RECORDED"
SET DIR(0)="E"
DO ^DIR
GOTO END
+6 KILL ^TMP("SDWLD",$JOB)
DO HD
+7 DO PAT
if DFN<0
GOTO END
OPT ;S SDWLPCMM=0,SDWLERR=0 I $D(SDWLOPT),SDWLOPT D - SD*5.3*769 -EWL Decom
QUIT
+1 ;.S %=2 W !,"DO YOU WISH TO PLACE THIS PATIENT ON A WAITING LIST " D YN^DICN
+2 ;.I %=-1!(%=2) S SDWLERR=1 Q
+3 ;I $D(SDWLOPT),SDWLOPT,SDWLERR Q
+4 ;S SDWLDFN=DFN
+5 ;D 1^VADPT
+6 ;S (SDWLTEM,SDWLPOS)=0
EN1 NEW SDWLNEW,SDWLERR,SDWLCN,SDWLWTE
SET SDWLNEW=0
SET SDWLERR=0
SET SDWLCN=0
SET SDWLWTE=0
+1 ; OG ; SD*5.3*446 ; Inter-facility transfer
if $$EN^SDWLE6(SDWLDFN,.SDWLERR)
GOTO EN2
+2 DO DIS
+3 IF $DATA(^SDWL(409.3,"B",DFN))
IF 'SDWLCN
WRITE !!,"PATIENT: ",VADM(1),?40,VA("PID")
+4 SET SDWLPS=$SELECT(SDWLCN>1:1,SDWLCN=1:2,1:3)
+5 IF $DATA(SDWLOPT)
IF SDWLOPT
IF SDWLPS=3
SET X="Y"
GOTO ENO
+6 IF SDWLPS=1
SET DIR(0)="FOA^^"
SET DIR("A")="Select Wait List (1-"_SDWLCN_") or Enter 'N' for New or '^' to Quit ? "
SET DIR("?")="Enter a Valid Number or 'N' for New."
+7 IF SDWLPS=2
SET DIR(0)="FOA^^"
SET DIR("A")="Select Wait List (1) or Enter 'N' for New or '^' to Quit ? "
SET DIR("?")="Enter a '1' or 'N' for New."
+8 IF SDWLPS=3
SET DIR(0)="YAO^^S X=""Y"""
SET DIR("A")="Patient is not on Waiting List. Do you wish to Add Patient? Yes// "
+9 WRITE !
DO ^DIR
WRITE !
KILL DIR
+10 if $DATA(DUOUT)
GOTO END
if $DATA(DTOUT)
GOTO END
+11 IF SDWLPS=1
Begin DoDot:1
+12 SET SDWLERR=$SELECT(X?1"N".E:0,X?1"n".E:0,X="":2,$DATA(DUOUT):1,X["^":1,$DATA(^TMP("SDWLD",$JOB,DFN,+X)):0,1:2)
QUIT
End DoDot:1
if SDWLERR=1
GOTO EN3
IF SDWLERR=2
WRITE *7," ??"
GOTO EN1
+13 IF SDWLPS=2
Begin DoDot:1
+14 SET SDWLERR=$SELECT(X?1"N".E:0,X?1"n".E:0,X="":2,$DATA(DUOUT):1,X["^":1,$DATA(^TMP("SDWLD",$JOB,DFN,+X)):0,1:2)
QUIT
End DoDot:1
if SDWLERR=1
GOTO EN3
IF SDWLERR=2
WRITE *7," ??"
GOTO EN1
ENO IF SDWLPS=3
Begin DoDot:1
+1 SET SDWLERR=$SELECT(X?1"N".E:1,X?1"n".E:1,X="":0,X?1"Y".E:0,X?1"y".E:0,$DATA(DUOUT):1,X["^":1,1:2)
QUIT
End DoDot:1
if SDWLERR=1
GOTO EN3
IF SDWLERR=2
WRITE *7," ??"
GOTO EN1
+2 IF SDWLPS=1!(SDWLPS=2)
IF X?1N.N
Begin DoDot:1
+3 NEW DA,SDWLDA
SET (DA,SDWLDA)=$PIECE($GET(^TMP("SDWLD",$JOB,DFN,+X)),"~",2)
SET SDWLEDIT=""
+4 ;
+5 ;LOCK DATA FILE
+6 ;
+7 LOCK +^SDWL(409.3,DA):5
IF '$TEST
WRITE !,"ANOTHER TERMINAL IS EDITING THIS ENTRY. TRY LATER."
SET DUOUT=1
+8 IF $DATA(DUOUT)
QUIT
+9 ; OG ; This and the following six lines added for patch 415
NEW SDWLINNM,SDWLSTN
+10 IF $$GETTRN^SDWLIFT1(SDWLDA,.SDWLINNM,.SDWLSTN)
Begin DoDot:2
+11 NEW SDWLMSG,SDWLI
+12 SET SDWLMSG(0)=1
SET SDWLMSG(SDWLMSG(0),0)="This entry is the subject of a transfer to "_SDWLINNM_" ("_SDWLSTN_"). Editing inhibited."
+13 IF $LENGTH(SDWLMSG(SDWLMSG(0),0))>80
DO COL80^SDWLIFT(.SDWLMSG)
+14 FOR SDWLI=1:1:SDWLMSG(0)
WRITE !,SDWLMSG(SDWLI,0)
+15 QUIT
End DoDot:2
SET DUOUT=1
QUIT
+16 DO EN^SDWLE10
+17 DO EDIT
WRITE !!,"Editing is Completed"
SET SDWLERR=1
KILL SDWLEDIT
End DoDot:1
+18 if SDWLERR
GOTO END
+19 IF SDWLPS=1!(SDWLPS=2)
IF X?1"N".E!(X?1"n".E)
DO NEW
DO EDIT
SET SDWLNEW=""
GOTO EN2
+20 IF SDWLPS=3
DO NEW
DO EDIT
SET SDWLNEW=""
EN2 IF $DATA(SDWLNEW)
IF '$DATA(DUOUT)
IF 'SDWLERR
WRITE !!,?15,"*** Patient has been added to Wait List ***",!
+1 KILL SDWLNEW,DUOUT
+2 ;
+3 ;UNLOCK FILE AND KILL LOCAL VARIABLES
+4 ;
+5 IF $DATA(SDWLDA)
LOCK -^SDWL(409.3,SDWLDA)
+6 ;-exit logic
EN3 DO END^SDWLE113
+1 QUIT
END DO END^SDWLE113
+1 DO EN^SDWLKIL
+2 QUIT
+3 ;
+4 ;
PAT ;SELECT PATIENT
+1 ;
+2 SET DIC(0)="EMNZAQ"
SET DIC=2
DO ^DIC
SET (SDWLDFN,DFN)=$PIECE(Y,U,1)
if DFN<0
GOTO PAT1
+3 SET X=$$GET1^DIQ(2,DFN_",",".351")
IF X'=""
WRITE !,*7,"PATIENT'S DATE OF DEATH HAS BEEN RECORDED"
GOTO PAT
+4 SET SDWLSSN=$GET(VA("PID"))
SET SDWLNAM=$GET(VA(1))
PAT1 KILL VADM,VAIN,VAERR,VA
QUIT
+1 ;
DIS ;DISPLAY DATA FOR PATIENT
+1 ;
+2 SET SDWLHDR="Wait List Enter/Edit"
+3 DO EN^SDWLD(DFN,VA("PID"),VADM(1))
+4 DO PCM^SDWLE1
DO PCMD^SDWLE1
+5 QUIT
+6 ;
NEW ;
+1 DO NEW^SDWLE11
+2 QUIT
+3 ;
EDIT ;
+1 DO EN^SDWLE111
IF $DATA(DUOUT)
if '$DATA(SDWLEDIT)
DO END^SDWLE113
QUIT
+2 IF SDWLTYE=4
DO ED4
KILL DIR,DIE,DIC,DR
QUIT
+3 IF SDWLTYE=3
DO ED3
KILL DIR,DIE,DIC,DR
QUIT
+4 IF SDWLTYE=2
DO ED2
KILL DIR,DIE,DIC,DR
QUIT
+5 IF SDWLTYE=1
DO ED1
KILL DIR,DIE,DIC,DR
QUIT
+6 QUIT
ED1 ;-team
+1 IF $DATA(DUOUT)
if '$DATA(SDWLEDIT)
DO END^SDWLE113
QUIT
+2 DO EN^SDWLE3
IF '$DATA(DUOUT)
DO EN^SDWLE113
QUIT
+3 QUIT
ED2 ;-position
+1 IF $DATA(DUOUT)
if '$DATA(SDWLEDIT)
DO END^SDWLE113
QUIT
+2 DO EN^SDWLE5
IF '$DATA(DUOUT)
DO EN^SDWLE113
QUIT
+3 QUIT
ED3 ;-specialty
+1 DO EN^SDWLE2
IF $DATA(DUOUT)
if '$DATA(SDWLEDIT)
DO END^SDWLE113
QUIT
+2 DO EN^SDWLE110
IF $DATA(DUOUT)
if '$DATA(SDWLEDIT)
DO END^SDWLE113
QUIT
+3 IF '$DATA(DUOUT)
DO EN^SDWLE113
+4 DO END^SDWLE113
+5 QUIT
ED4 ;-clinic
+1 DO EN^SDWLE4
IF $DATA(DUOUT)
if '$DATA(SDWLEDIT)
DO END^SDWLE113
QUIT
+2 DO EN^SDWLE110
IF $DATA(DUOUT)
if '$DATA(SDWLEDIT)
DO END^SDWLE113
QUIT
+3 IF '$DATA(DUOUT)
DO EN^SDWLE113
+4 DO END^SDWLE113
+5 QUIT
+6 ;
ED5 DO END^SDWLE113
+1 QUIT
SB1 SET X=$$GET1^DIQ(2,DFN_",",".351")
IF X'=""
SET DUOUT=""
+1 QUIT
HD if $DATA(IOF)
WRITE @IOF
WRITE !,?80-$LENGTH("Scheduling/PCMM Enter/Edit Wait List")\2,"Scheduling/PCMM Enter/Edit Wait List",!!
+1 IF $DATA(DFN)
IF DFN'=""
IF '$DATA(^SDWL(409.3,"B",DFN))
IF $DATA(SDWLLIST)
IF SDWLLIST
Begin DoDot:1
+2 WRITE !!,"PATIENT: ",VADM(1),?40,VA("PID")
End DoDot:1
+3 QUIT
