SDWLEC ;;IOFO BAY PINES/ESW - CLOSED WAITING LIST-EDIT;06/12/2002; Compiled April 17, 2009 14:22:44
;;5.3;scheduling;**446,539**;AUG 13 1993;Build 24
;
;modified SDWLE
;******************************************************************
; CHANGE LOG
;
; DATE PATCH DESCRIPTION
; ---- ----- -----------
; 09JUN2005 446 Inter-Facility Transfer.
;
;
EN ;ENTRY POINT - INTIALIZE VARIABLES
N DTOUT,%,SDWLHDR,SDWLNAM,SDWLSSN,SDWLTEM,SDWLPOS,VADM,VA,X,SDWLPS
I $D(SDWLOPT),SDWLOPT G OPT
I $D(SDWLLIST),SDWLLIST,$D(DFN),DFN<0 K SDWLLIST
N SDWLDFN
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 ;
N SDWLDFN,SDWLNEW,SDWLERR,SDWLCN,SDWLWTE,SDWLPS
S SDWLDFN=DFN
D 1^VADPT
S (SDWLTEM,SDWLPOS)=0
EN1 S (SDWLNEW,SDWLERR,SDWLCN,SDWLWTE)=0
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 '^' to Quit ? ",DIR("?")="Enter a Valid Number or '^' to Quit."
I SDWLPS=2 S DIR(0)="FOA^^" S DIR("A")="Select Wait List (1) or '^' to Quit ? ",DIR("?")="Enter a '1' or '^' to Quit."
I SDWLPS=3 S DIR(0)="YAO^^S X=""Y""" S DIR("A")="No closed EWL entries for this range of dates. Do you wish to continue with this patient? Yes// "
W ! D ^DIR W ! K DIR
G END:$D(DUOUT),END:$D(DTOUT)
I SDWLPS=1 D G END:SDWLERR=1 I SDWLERR=2 W *7," ??" G EN1
.S SDWLERR=$S(X="":2,X["^":1,$D(^TMP("SDWLD",$J,DFN,+X)):0,1:2) Q
I SDWLPS=2 D G END:SDWLERR=1 I SDWLERR=2 W *7," ??" G EN1
.S SDWLERR=$S(X="":2,$D(DUOUT):1,X["^":1,$D(^TMP("SDWLD",$J,DFN,+X)):0,1:2) Q
ENO I SDWLPS=3 D G EN:SDWLERR=1 I SDWLERR=2 G EN1
.S SDWLERR=$S(X="":2,X?1"Y".E:2,X?1"y".E:2,$D(DUOUT):1,X["^":1,1:1)
.I SDWLERR=1 K DFN Q
N SDCAN I SDWLPS=1!(SDWLPS=2),X?1N.N D
.N DA S (DA,SDWLDA)=$P($G(^TMP("SDWLD",$J,DFN,+X)),"~",2),SDWLEDIT=""
.;
.;LOCK DATA FILE
.;
.L +^SDWL(409.3,SDWLDA):$S($G(DILOCKTM)>5:DILOCKTM,1:5) I '$T W !,"ANOTHER TERMINAL IS EDITING THIS ENTRY. TRY LATER." S DUOUT=1
.I $D(DUOUT) Q
.D EN^SDWLE10
.D EDITC(SDWLDA,.SDCAN) L -^SDWL(409.3,SDWLDA) S SDWLERR=1 K SDWLEDIT
.I SDCAN W !,"This process has been canceled."
.E W !,"The requested entry has been opened."
D END
Q
END ;
D EN^SDWLKIL
Q
;
;
PAT ;SELECT PATIENT
;
N DIC 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 OPEN CLOSED ENTRY"
D EN^SDWLD(DFN,VA("PID"),VADM(1),"C")
D PCM^SDWLE1,PCMD^SDWLE1
Q
;
EDITC(SDWLDA,SDCAN) ;edit closed entry
N SDCLR S SDCLR=$P(^SDWL(409.3,SDWLDA,"DIS"),U,3) I SDCLR="ER"!(SDCLR="D") S SDCAN=1 D S SDCAN=1 Q
.I SDCLR="ER" W !," ENTERED IN ERROR - NOT TO BE OPENED"
W !,"Reopen comment required to open this entry. Reopen reason: O - Other.",!
;Reopen comment
N DIR,Y S Y=0,SDCAN=0
F Q:$L(Y)>10!(Y="^") S DIR(0)="FAOU^^",DIR("A")="Comments or '^' to cancel this process: ",DIR("B")="" D ^DIR D
.I $L(Y)<11 W !,"At least 10 char comment required" Q
.I X="^" Q
I Y="^" S SDCAN=1 Q
N SDWLCM S SDWLCM=$E(Y,1,70)
N DIE,DR,DA
S DIE="^SDWL(409.3,",DA=SDWLDA,DR="23////^S X=""O""" D ^DIE
S DR="28///^S X=$G(DUZ);29////^S X=""O""" D ^DIE ; REOPEN REASON - OTHER
S DR="19///@;20///@;21///@;30///^S X=SDWLCM" D ^DIE
S DR="13///@;13.1////@;13.2///@;13.3///@;13.4///@;13.5///@;13.6///@;13.8///@;13.7///@" D ^DIE ;SD/467
Q
SB1 S X=$$GET1^DIQ(2,DFN_",",".351") I X'="" S DUOUT=""
Q
HD W:$D(IOF) @IOF W !,?80-$L("Scheduling/PCMM Open Closed Wait Entry")\2,"Scheduling/PCMM Open Closed Wait List Entry",!!
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[HSDWLEC 4438 printed Oct 16, 2024@19:02:59 Page 2
SDWLEC ;;IOFO BAY PINES/ESW - CLOSED WAITING LIST-EDIT;06/12/2002; Compiled April 17, 2009 14:22:44
+1 ;;5.3;scheduling;**446,539**;AUG 13 1993;Build 24
+2 ;
+3 ;modified SDWLE
+4 ;******************************************************************
+5 ; CHANGE LOG
+6 ;
+7 ; DATE PATCH DESCRIPTION
+8 ; ---- ----- -----------
+9 ; 09JUN2005 446 Inter-Facility Transfer.
+10 ;
+11 ;
EN ;ENTRY POINT - INTIALIZE VARIABLES
+1 NEW DTOUT,%,SDWLHDR,SDWLNAM,SDWLSSN,SDWLTEM,SDWLPOS,VADM,VA,X,SDWLPS
+2 IF $DATA(SDWLOPT)
IF SDWLOPT
GOTO OPT
+3 IF $DATA(SDWLLIST)
IF SDWLLIST
IF $DATA(DFN)
IF DFN<0
KILL SDWLLIST
+4 NEW SDWLDFN
+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 ;
+1 NEW SDWLDFN,SDWLNEW,SDWLERR,SDWLCN,SDWLWTE,SDWLPS
+2 SET SDWLDFN=DFN
+3 DO 1^VADPT
+4 SET (SDWLTEM,SDWLPOS)=0
EN1 SET (SDWLNEW,SDWLERR,SDWLCN,SDWLWTE)=0
+1 DO DIS
+2 IF $DATA(^SDWL(409.3,"B",DFN))
IF 'SDWLCN
WRITE !!,"PATIENT: ",VADM(1),?40,VA("PID")
+3 SET SDWLPS=$SELECT(SDWLCN>1:1,SDWLCN=1:2,1:3)
+4 IF $DATA(SDWLOPT)
IF SDWLOPT
IF SDWLPS=3
SET X="Y"
GOTO ENO
+5 IF SDWLPS=1
SET DIR(0)="FOA^^"
SET DIR("A")="Select Wait List (1-"_SDWLCN_") or '^' to Quit ? "
SET DIR("?")="Enter a Valid Number or '^' to Quit."
+6 IF SDWLPS=2
SET DIR(0)="FOA^^"
SET DIR("A")="Select Wait List (1) or '^' to Quit ? "
SET DIR("?")="Enter a '1' or '^' to Quit."
+7 IF SDWLPS=3
SET DIR(0)="YAO^^S X=""Y"""
SET DIR("A")="No closed EWL entries for this range of dates. Do you wish to continue with this patient? Yes// "
+8 WRITE !
DO ^DIR
WRITE !
KILL DIR
+9 if $DATA(DUOUT)
GOTO END
if $DATA(DTOUT)
GOTO END
+10 IF SDWLPS=1
Begin DoDot:1
+11 SET SDWLERR=$SELECT(X="":2,X["^":1,$DATA(^TMP("SDWLD",$JOB,DFN,+X)):0,1:2)
QUIT
End DoDot:1
if SDWLERR=1
GOTO END
IF SDWLERR=2
WRITE *7," ??"
GOTO EN1
+12 IF SDWLPS=2
Begin DoDot:1
+13 SET SDWLERR=$SELECT(X="":2,$DATA(DUOUT):1,X["^":1,$DATA(^TMP("SDWLD",$JOB,DFN,+X)):0,1:2)
QUIT
End DoDot:1
if SDWLERR=1
GOTO END
IF SDWLERR=2
WRITE *7," ??"
GOTO EN1
ENO IF SDWLPS=3
Begin DoDot:1
+1 SET SDWLERR=$SELECT(X="":2,X?1"Y".E:2,X?1"y".E:2,$DATA(DUOUT):1,X["^":1,1:1)
+2 IF SDWLERR=1
KILL DFN
QUIT
End DoDot:1
if SDWLERR=1
GOTO EN
IF SDWLERR=2
GOTO EN1
+3 NEW SDCAN
IF SDWLPS=1!(SDWLPS=2)
IF X?1N.N
Begin DoDot:1
+4 NEW DA
SET (DA,SDWLDA)=$PIECE($GET(^TMP("SDWLD",$JOB,DFN,+X)),"~",2)
SET SDWLEDIT=""
+5 ;
+6 ;LOCK DATA FILE
+7 ;
+8 LOCK +^SDWL(409.3,SDWLDA):$SELECT($GET(DILOCKTM)>5:DILOCKTM,1:5)
IF '$TEST
WRITE !,"ANOTHER TERMINAL IS EDITING THIS ENTRY. TRY LATER."
SET DUOUT=1
+9 IF $DATA(DUOUT)
QUIT
+10 DO EN^SDWLE10
+11 DO EDITC(SDWLDA,.SDCAN)
LOCK -^SDWL(409.3,SDWLDA)
SET SDWLERR=1
KILL SDWLEDIT
+12 IF SDCAN
WRITE !,"This process has been canceled."
+13 IF '$TEST
WRITE !,"The requested entry has been opened."
End DoDot:1
+14 DO END
+15 QUIT
END ;
+1 DO EN^SDWLKIL
+2 QUIT
+3 ;
+4 ;
PAT ;SELECT PATIENT
+1 ;
+2 NEW DIC
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 OPEN CLOSED ENTRY"
+3 DO EN^SDWLD(DFN,VA("PID"),VADM(1),"C")
+4 DO PCM^SDWLE1
DO PCMD^SDWLE1
+5 QUIT
+6 ;
EDITC(SDWLDA,SDCAN) ;edit closed entry
+1 NEW SDCLR
SET SDCLR=$PIECE(^SDWL(409.3,SDWLDA,"DIS"),U,3)
IF SDCLR="ER"!(SDCLR="D")
SET SDCAN=1
Begin DoDot:1
+2 IF SDCLR="ER"
WRITE !," ENTERED IN ERROR - NOT TO BE OPENED"
End DoDot:1
SET SDCAN=1
QUIT
+3 WRITE !,"Reopen comment required to open this entry. Reopen reason: O - Other.",!
+4 ;Reopen comment
+5 NEW DIR,Y
SET Y=0
SET SDCAN=0
+6 FOR
if $LENGTH(Y)>10!(Y="^")
QUIT
SET DIR(0)="FAOU^^"
SET DIR("A")="Comments or '^' to cancel this process: "
SET DIR("B")=""
DO ^DIR
Begin DoDot:1
+7 IF $LENGTH(Y)<11
WRITE !,"At least 10 char comment required"
QUIT
+8 IF X="^"
QUIT
End DoDot:1
+9 IF Y="^"
SET SDCAN=1
QUIT
+10 NEW SDWLCM
SET SDWLCM=$EXTRACT(Y,1,70)
+11 NEW DIE,DR,DA
+12 SET DIE="^SDWL(409.3,"
SET DA=SDWLDA
SET DR="23////^S X=""O"""
DO ^DIE
+13 ; REOPEN REASON - OTHER
SET DR="28///^S X=$G(DUZ);29////^S X=""O"""
DO ^DIE
+14 SET DR="19///@;20///@;21///@;30///^S X=SDWLCM"
DO ^DIE
+15 ;SD/467
SET DR="13///@;13.1////@;13.2///@;13.3///@;13.4///@;13.5///@;13.6///@;13.8///@;13.7///@"
DO ^DIE
+16 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 Open Closed Wait Entry")\2,"Scheduling/PCMM Open Closed Wait List Entry",!!
+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
