SDWLSCPE ;IOFO BAY PINES/TEH - EWL - EDIT SC PRIORITY ;20 Aug 2002 2:10 PM
;;5.3;scheduling;**394**;AUG 13 1993
;
;
;******************************************************************
; CHANGE LOG
;
; DATE PATCH DESCRIPTION
; ---- ----- -----------
;
;12/09/2004 SD*5.3*394 New routine to edit SC PRIORITY in SDWL(409.3,DA,"SC") Field 15
;
;Variables: DFN not kill - referenced only.
;
;
;
EN ;Called from option file.
S SDWLERR=0 I $D(SDWLLIST),SDWLLIST D
.I '$D(DFN) S SDWLERR=1 Q
.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
I $D(DUOUT) Q
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") N SDWLBDT S (SDWLBDT,SDWLEDT)="" D DIS G EN1
K DIR,DIC,DR,DIE
;OPTION HEADER
;
S SDWLOP=" - Edit SC Priority Patient" D HD
;
;PATIENT LOOK-UP FROM WAIT LIST PATIENT FILE (^SDWL(409.3,IEN,0).
;
D PAT G END:'$D(SDWLDFN),END:SDWLDFN<0,END:SDWLDFN=""
;
;DISPLAY PATIENT DATA FROM ^SDWL(409.3,IEN,0).
;
D DIS
;PROMPT USER FOR RECORD.
;
EN1 K DIR,DIC,DIE,DR,X,Y,SDWLERR S SDWLPS=$S(SDWLCN>1:1,SDWLCN=1:2,1:0),SDWLERR=0
I SDWLPS=0 W !!,"Patient has no Wait List Entries to edit." S DIR(0)="E" D ^DIR G END
I SDWLPS=1 S DIR(0)="FOA^^" S DIR("A")="Select Wait List (1-"_SDWLCN_") or '^' to Quit? "
I SDWLPS=2 S DIR(0)="FOA^^" S DIR("A")="Edit This 'ENTRY' or '^' to Quit? Yes // "
W ! D ^DIR G END:X["^" S SDWLY=Y W !
I SDWLPS=1 D
.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)
I $D(SDWLERR),SDWLERR=2 W *7," Invalid Entry" G EN1
I SDWLPS=2 D
.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)
I SDWLERR=2 W *7," Invalid Entry" G EN1
G END:SDWLERR
I SDWLPS=2,'SDWLY S SDWLY=1
S SDWLERR=0 I SDWLY?1N.N D G EN1:SDWLERR
.K DIR,DIC,DR
.;
.;CHECK FOR VALID ENTRY
.;
.I '$D(^TMP("SDWLD",$J,SDWLDFN,+SDWLY)) W " Invalid Entry " S SDWLERR=1 Q
.S SDWLDA=$P($G(^TMP("SDWLD",$J,SDWLDFN,+SDWLY)),"~",2)
.;
.;LOCK DATA FILE
.;
.L ^SDWL(409.3,SDWLDA):5 I '$T W !,"Another User is Editing this Entry. Try Later." S DUOUT=1
I $D(DUOUT) G END
;
;GET PATIENT DATA FROM ^SDWL(409.3,IEN,0).
;
D GETDATA
;
;ENTER SERVICE CONNECTED PRIORITY
;
D EDIT G END:$D(DUOUT)
K DIR,DIE,DR,DIC
S DIR(0)="E" D ^DIR I $D(DUOUT) G END
D END G EN
;
Q
PAT ;PATIENT LOOK-UP
;
S DIC(0)="EMNAQ",DIC=409.3 D ^DIC S (SDWLDFN,DFN)=$P(Y,U,2) G PAT1:DFN<0
G PAT1:DFN=""
S SDWLNAM=$$GET1^DIQ(2,DFN_",",.01)
S X=$$GET1^DIQ(2,DFN_",",".351") I X'="" W !,*7,"PATIENT'S DATE OF DEATH HAS BEEN RECORDED" G PAT
D 1^VADPT
PAT1 Q
;
DIS ;DISPLAY DATA FOR PATIENT
;
S SDWLDISC="",SDWLCN=0,SDWLHDR="Wait List Service Connected Priority Edit"
D EN^SDWLD(SDWLDFN,VA("PID"),VADM(1))
K VADM,VAIN,VA,SDWLDISC
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)
S SDWLPROV=$P(SDWLDATA,U,12),SDWLDAPT=$P(SDWLDATA,U,16),SDWLST=$P(SDWLDATA,U,17),SDWLDUZ=DUZ,SDWLEDT=DT
S SDWLSCP=$P($G(^SDWL(409.3,SDWLDA,"SC")),U,2)
Q
EDIT ;EDIT PRIORITY
;
S SDWLDUZ=DUZ,SDWLERR=0 K DIR,DR,DIE,DIC
S DIR("A")="Service Connected Priority"
S DIR("B")=$$EXTERNAL^DILFD(409.3,15,,SDWLSCP)
S DIR(0)="Y"
D ^DIR
I SDWLSCP>49,X?1."N",X?1"n" W !,"Invalid Entry. Service Connected Percentage greater than 49%" G EDIT
I X="" S DUOUT=1 Q
I X="^" S DUOUT=1 Q
S SDWLSCPX=$S(X?1"Y".E:1,X?1"y".E:1,1:0)
D DIE(SDWLDA,SDWLSCPX)
Q
;
DIE(DA,SDWLDIS) ; Update file 409.3 with SERVICE CONNECTED PRIORITY data.
S DIE="^SDWL(409.3,"
S DR="15///^S X=SDWLSCPX"
D ^DIE
Q
HD ;HEADER
;
W:$D(IOF) @IOF W !!,?80-$L("Wait List - SERVICE CONNECTED PRIORITY")\2,"Wait List - SERVICE CONNECTED PRIORITY",!!
;
END ;QUIT OPTION
K DIC,DIR,DR,DIE,SDWLDFN,DUOUT,SDWLSCP,SDWLSCPX,SDWLLIST,SDWLCN
K SDWLCL,SDWSLCN,SDWLDA,SDWLDAPT,SDWLDATA,SDWLDFN,SDWLDISP,SDWLDUZ,SDWLEDT,SDWLERR,SDWLIN,SDWLNAM,SDWLOP,SDWLPRI
K SDWLPROV,SDWLPS,SDWLRB,SDWLSC,SDWLSP,SDWLSS,SDWLST,SDWLTY,SDWLY,X,Y,SDWLHDR
L Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLSCPE 4617 printed Dec 13, 2024@03:03:25 Page 2
SDWLSCPE ;IOFO BAY PINES/TEH - EWL - EDIT SC PRIORITY ;20 Aug 2002 2:10 PM
+1 ;;5.3;scheduling;**394**;AUG 13 1993
+2 ;
+3 ;
+4 ;******************************************************************
+5 ; CHANGE LOG
+6 ;
+7 ; DATE PATCH DESCRIPTION
+8 ; ---- ----- -----------
+9 ;
+10 ;12/09/2004 SD*5.3*394 New routine to edit SC PRIORITY in SDWL(409.3,DA,"SC") Field 15
+11 ;
+12 ;Variables: DFN not kill - referenced only.
+13 ;
+14 ;
+15 ;
EN ;Called from option file.
+1 SET SDWLERR=0
IF $DATA(SDWLLIST)
IF SDWLLIST
Begin DoDot:1
+2 IF '$DATA(DFN)
SET SDWLERR=1
QUIT
+3 IF $DATA(DFN)
IF '$DATA(^SDWL(409.3,"B",DFN))
DO HD
DO 1^VADPT
DO DEM^VADPT
WRITE !,VADM(1),?40,VA("PID"),*7,!,"This Patient has NO entries on the Electronic Wait List."
SET DIR(0)="E"
DO ^DIR
SET DUOUT=1
QUIT
End DoDot:1
+4 IF $DATA(DUOUT)
QUIT
+5 IF 'SDWLERR
IF $DATA(SDWLLIST)
IF SDWLLIST
DO HD
SET SDWLDFN=DFN
KILL DIR,DIC,DR,DIE,VADM
DO 1^VADPT
DO DEM^VADPT
WRITE !,VADM(1),?40,VA("PID")
NEW SDWLBDT
SET (SDWLBDT,SDWLEDT)=""
DO DIS
GOTO EN1
+6 KILL DIR,DIC,DR,DIE
+7 ;OPTION HEADER
+8 ;
+9 SET SDWLOP=" - Edit SC Priority Patient"
DO HD
+10 ;
+11 ;PATIENT LOOK-UP FROM WAIT LIST PATIENT FILE (^SDWL(409.3,IEN,0).
+12 ;
+13 DO PAT
if '$DATA(SDWLDFN)
GOTO END
if SDWLDFN<0
GOTO END
if SDWLDFN=""
GOTO END
+14 ;
+15 ;DISPLAY PATIENT DATA FROM ^SDWL(409.3,IEN,0).
+16 ;
+17 DO DIS
+18 ;PROMPT USER FOR RECORD.
+19 ;
EN1 KILL DIR,DIC,DIE,DR,X,Y,SDWLERR
SET SDWLPS=$SELECT(SDWLCN>1:1,SDWLCN=1:2,1:0)
SET SDWLERR=0
+1 IF SDWLPS=0
WRITE !!,"Patient has no Wait List Entries to edit."
SET DIR(0)="E"
DO ^DIR
GOTO END
+2 IF SDWLPS=1
SET DIR(0)="FOA^^"
SET DIR("A")="Select Wait List (1-"_SDWLCN_") or '^' to Quit? "
+3 IF SDWLPS=2
SET DIR(0)="FOA^^"
SET DIR("A")="Edit This 'ENTRY' or '^' to Quit? Yes // "
+4 WRITE !
DO ^DIR
if X["^"
GOTO END
SET SDWLY=Y
WRITE !
+5 IF SDWLPS=1
Begin DoDot:1
+6 SET SDWLERR=$SELECT(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,$DATA(DUOUT):1,X["^":1,1:2)
End DoDot:1
+7 IF $DATA(SDWLERR)
IF SDWLERR=2
WRITE *7," Invalid Entry"
GOTO EN1
+8 IF SDWLPS=2
Begin DoDot:1
+9 SET SDWLERR=$SELECT(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)
End DoDot:1
+10 IF SDWLERR=2
WRITE *7," Invalid Entry"
GOTO EN1
+11 if SDWLERR
GOTO END
+12 IF SDWLPS=2
IF 'SDWLY
SET SDWLY=1
+13 SET SDWLERR=0
IF SDWLY?1N.N
Begin DoDot:1
+14 KILL DIR,DIC,DR
+15 ;
+16 ;CHECK FOR VALID ENTRY
+17 ;
+18 IF '$DATA(^TMP("SDWLD",$JOB,SDWLDFN,+SDWLY))
WRITE " Invalid Entry "
SET SDWLERR=1
QUIT
+19 SET SDWLDA=$PIECE($GET(^TMP("SDWLD",$JOB,SDWLDFN,+SDWLY)),"~",2)
+20 ;
+21 ;LOCK DATA FILE
+22 ;
+23 LOCK ^SDWL(409.3,SDWLDA):5
IF '$TEST
WRITE !,"Another User is Editing this Entry. Try Later."
SET DUOUT=1
End DoDot:1
if SDWLERR
GOTO EN1
+24 IF $DATA(DUOUT)
GOTO END
+25 ;
+26 ;GET PATIENT DATA FROM ^SDWL(409.3,IEN,0).
+27 ;
+28 DO GETDATA
+29 ;
+30 ;ENTER SERVICE CONNECTED PRIORITY
+31 ;
+32 DO EDIT
if $DATA(DUOUT)
GOTO END
+33 KILL DIR,DIE,DR,DIC
+34 SET DIR(0)="E"
DO ^DIR
IF $DATA(DUOUT)
GOTO END
+35 DO END
GOTO EN
+36 ;
+37 QUIT
PAT ;PATIENT LOOK-UP
+1 ;
+2 SET DIC(0)="EMNAQ"
SET DIC=409.3
DO ^DIC
SET (SDWLDFN,DFN)=$PIECE(Y,U,2)
if DFN<0
GOTO PAT1
+3 if DFN=""
GOTO PAT1
+4 SET SDWLNAM=$$GET1^DIQ(2,DFN_",",.01)
+5 SET X=$$GET1^DIQ(2,DFN_",",".351")
IF X'=""
WRITE !,*7,"PATIENT'S DATE OF DEATH HAS BEEN RECORDED"
GOTO PAT
+6 DO 1^VADPT
PAT1 QUIT
+1 ;
DIS ;DISPLAY DATA FOR PATIENT
+1 ;
+2 SET SDWLDISC=""
SET SDWLCN=0
SET SDWLHDR="Wait List Service Connected Priority Edit"
+3 DO EN^SDWLD(SDWLDFN,VA("PID"),VADM(1))
+4 KILL VADM,VAIN,VA,SDWLDISC
+5 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 SET SDWLPROV=$PIECE(SDWLDATA,U,12)
SET SDWLDAPT=$PIECE(SDWLDATA,U,16)
SET SDWLST=$PIECE(SDWLDATA,U,17)
SET SDWLDUZ=DUZ
SET SDWLEDT=DT
+6 SET SDWLSCP=$PIECE($GET(^SDWL(409.3,SDWLDA,"SC")),U,2)
+7 QUIT
EDIT ;EDIT PRIORITY
+1 ;
+2 SET SDWLDUZ=DUZ
SET SDWLERR=0
KILL DIR,DR,DIE,DIC
+3 SET DIR("A")="Service Connected Priority"
+4 SET DIR("B")=$$EXTERNAL^DILFD(409.3,15,,SDWLSCP)
+5 SET DIR(0)="Y"
+6 DO ^DIR
+7 IF SDWLSCP>49
IF X?1."N"
IF X?1"n"
WRITE !,"Invalid Entry. Service Connected Percentage greater than 49%"
GOTO EDIT
+8 IF X=""
SET DUOUT=1
QUIT
+9 IF X="^"
SET DUOUT=1
QUIT
+10 SET SDWLSCPX=$SELECT(X?1"Y".E:1,X?1"y".E:1,1:0)
+11 DO DIE(SDWLDA,SDWLSCPX)
+12 QUIT
+13 ;
DIE(DA,SDWLDIS) ; Update file 409.3 with SERVICE CONNECTED PRIORITY data.
+1 SET DIE="^SDWL(409.3,"
+2 SET DR="15///^S X=SDWLSCPX"
+3 DO ^DIE
+4 QUIT
HD ;HEADER
+1 ;
+2 if $DATA(IOF)
WRITE @IOF
WRITE !!,?80-$LENGTH("Wait List - SERVICE CONNECTED PRIORITY")\2,"Wait List - SERVICE CONNECTED PRIORITY",!!
+3 ;
END ;QUIT OPTION
+1 KILL DIC,DIR,DR,DIE,SDWLDFN,DUOUT,SDWLSCP,SDWLSCPX,SDWLLIST,SDWLCN
+2 KILL SDWLCL,SDWSLCN,SDWLDA,SDWLDAPT,SDWLDATA,SDWLDFN,SDWLDISP,SDWLDUZ,SDWLEDT,SDWLERR,SDWLIN,SDWLNAM,SDWLOP,SDWLPRI
+3 KILL SDWLPROV,SDWLPS,SDWLRB,SDWLSC,SDWLSP,SDWLSS,SDWLST,SDWLTY,SDWLY,X,Y,SDWLHDR
+4 LOCK
QUIT
