| [613] | 1 | SDWLSCPE ;IOFO BAY PINES/TEH - EWL - EDIT SC PRIORITY ;20 Aug 2002 2:10 PM
|
|---|
| 2 | ;;5.3;scheduling;**394**;AUG 13 1993
|
|---|
| 3 | ;
|
|---|
| 4 | ;
|
|---|
| 5 | ;******************************************************************
|
|---|
| 6 | ; CHANGE LOG
|
|---|
| 7 | ;
|
|---|
| 8 | ; DATE PATCH DESCRIPTION
|
|---|
| 9 | ; ---- ----- -----------
|
|---|
| 10 | ;
|
|---|
| 11 | ;12/09/2004 SD*5.3*394 New routine to edit SC PRIORITY in SDWL(409.3,DA,"SC") Field 15
|
|---|
| 12 | ;
|
|---|
| 13 | ;Variables: DFN not kill - referenced only.
|
|---|
| 14 | ;
|
|---|
| 15 | ;
|
|---|
| 16 | ;
|
|---|
| 17 | EN ;Called from option file.
|
|---|
| 18 | S SDWLERR=0 I $D(SDWLLIST),SDWLLIST D
|
|---|
| 19 | .I '$D(DFN) S SDWLERR=1 Q
|
|---|
| 20 | .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
|
|---|
| 21 | I $D(DUOUT) Q
|
|---|
| 22 | 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
|
|---|
| 23 | K DIR,DIC,DR,DIE
|
|---|
| 24 | ;OPTION HEADER
|
|---|
| 25 | ;
|
|---|
| 26 | S SDWLOP=" - Edit SC Priority Patient" D HD
|
|---|
| 27 | ;
|
|---|
| 28 | ;PATIENT LOOK-UP FROM WAIT LIST PATIENT FILE (^SDWL(409.3,IEN,0).
|
|---|
| 29 | ;
|
|---|
| 30 | D PAT G END:'$D(SDWLDFN),END:SDWLDFN<0,END:SDWLDFN=""
|
|---|
| 31 | ;
|
|---|
| 32 | ;DISPLAY PATIENT DATA FROM ^SDWL(409.3,IEN,0).
|
|---|
| 33 | ;
|
|---|
| 34 | D DIS
|
|---|
| 35 | ;PROMPT USER FOR RECORD.
|
|---|
| 36 | ;
|
|---|
| 37 | EN1 K DIR,DIC,DIE,DR,X,Y,SDWLERR S SDWLPS=$S(SDWLCN>1:1,SDWLCN=1:2,1:0),SDWLERR=0
|
|---|
| 38 | I SDWLPS=0 W !!,"Patient has no Wait List Entries to edit." S DIR(0)="E" D ^DIR G END
|
|---|
| 39 | I SDWLPS=1 S DIR(0)="FOA^^" S DIR("A")="Select Wait List (1-"_SDWLCN_") or '^' to Quit? "
|
|---|
| 40 | I SDWLPS=2 S DIR(0)="FOA^^" S DIR("A")="Edit This 'ENTRY' or '^' to Quit? Yes // "
|
|---|
| 41 | W ! D ^DIR G END:X["^" S SDWLY=Y W !
|
|---|
| 42 | I SDWLPS=1 D
|
|---|
| 43 | .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)
|
|---|
| 44 | I $D(SDWLERR),SDWLERR=2 W *7," Invalid Entry" G EN1
|
|---|
| 45 | I SDWLPS=2 D
|
|---|
| 46 | .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)
|
|---|
| 47 | I SDWLERR=2 W *7," Invalid Entry" G EN1
|
|---|
| 48 | G END:SDWLERR
|
|---|
| 49 | I SDWLPS=2,'SDWLY S SDWLY=1
|
|---|
| 50 | S SDWLERR=0 I SDWLY?1N.N D G EN1:SDWLERR
|
|---|
| 51 | .K DIR,DIC,DR
|
|---|
| 52 | .;
|
|---|
| 53 | .;CHECK FOR VALID ENTRY
|
|---|
| 54 | .;
|
|---|
| 55 | .I '$D(^TMP("SDWLD",$J,SDWLDFN,+SDWLY)) W " Invalid Entry " S SDWLERR=1 Q
|
|---|
| 56 | .S SDWLDA=$P($G(^TMP("SDWLD",$J,SDWLDFN,+SDWLY)),"~",2)
|
|---|
| 57 | .;
|
|---|
| 58 | .;LOCK DATA FILE
|
|---|
| 59 | .;
|
|---|
| 60 | .L ^SDWL(409.3,SDWLDA):5 I '$T W !,"Another User is Editing this Entry. Try Later." S DUOUT=1
|
|---|
| 61 | I $D(DUOUT) G END
|
|---|
| 62 | ;
|
|---|
| 63 | ;GET PATIENT DATA FROM ^SDWL(409.3,IEN,0).
|
|---|
| 64 | ;
|
|---|
| 65 | D GETDATA
|
|---|
| 66 | ;
|
|---|
| 67 | ;ENTER SERVICE CONNECTED PRIORITY
|
|---|
| 68 | ;
|
|---|
| 69 | D EDIT G END:$D(DUOUT)
|
|---|
| 70 | K DIR,DIE,DR,DIC
|
|---|
| 71 | S DIR(0)="E" D ^DIR I $D(DUOUT) G END
|
|---|
| 72 | D END G EN
|
|---|
| 73 | ;
|
|---|
| 74 | Q
|
|---|
| 75 | PAT ;PATIENT LOOK-UP
|
|---|
| 76 | ;
|
|---|
| 77 | S DIC(0)="EMNAQ",DIC=409.3 D ^DIC S (SDWLDFN,DFN)=$P(Y,U,2) G PAT1:DFN<0
|
|---|
| 78 | G PAT1:DFN=""
|
|---|
| 79 | S SDWLNAM=$$GET1^DIQ(2,DFN_",",.01)
|
|---|
| 80 | S X=$$GET1^DIQ(2,DFN_",",".351") I X'="" W !,*7,"PATIENT'S DATE OF DEATH HAS BEEN RECORDED" G PAT
|
|---|
| 81 | D 1^VADPT
|
|---|
| 82 | PAT1 Q
|
|---|
| 83 | ;
|
|---|
| 84 | DIS ;DISPLAY DATA FOR PATIENT
|
|---|
| 85 | ;
|
|---|
| 86 | S SDWLDISC="",SDWLCN=0,SDWLHDR="Wait List Service Connected Priority Edit"
|
|---|
| 87 | D EN^SDWLD(SDWLDFN,VA("PID"),VADM(1))
|
|---|
| 88 | K VADM,VAIN,VA,SDWLDISC
|
|---|
| 89 | Q
|
|---|
| 90 | GETDATA ;PATIENT DATA RETRIEVAL
|
|---|
| 91 | ;
|
|---|
| 92 | S SDWLDATA=$G(^SDWL(409.3,SDWLDA,0))
|
|---|
| 93 | S SDWLIN=$P(SDWLDATA,U,3),SDWLCL=+$P(SDWLDATA,U,4),SDWLTY=$P(SDWLDATA,U,5),SDWLST=$P(SDWLDATA,U,6)
|
|---|
| 94 | 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)
|
|---|
| 95 | S SDWLPROV=$P(SDWLDATA,U,12),SDWLDAPT=$P(SDWLDATA,U,16),SDWLST=$P(SDWLDATA,U,17),SDWLDUZ=DUZ,SDWLEDT=DT
|
|---|
| 96 | S SDWLSCP=$P($G(^SDWL(409.3,SDWLDA,"SC")),U,2)
|
|---|
| 97 | Q
|
|---|
| 98 | EDIT ;EDIT PRIORITY
|
|---|
| 99 | ;
|
|---|
| 100 | S SDWLDUZ=DUZ,SDWLERR=0 K DIR,DR,DIE,DIC
|
|---|
| 101 | S DIR("A")="Service Connected Priority"
|
|---|
| 102 | S DIR("B")=$$EXTERNAL^DILFD(409.3,15,,SDWLSCP)
|
|---|
| 103 | S DIR(0)="Y"
|
|---|
| 104 | D ^DIR
|
|---|
| 105 | I SDWLSCP>49,X?1."N",X?1"n" W !,"Invalid Entry. Service Connected Percentage greater than 49%" G EDIT
|
|---|
| 106 | I X="" S DUOUT=1 Q
|
|---|
| 107 | I X="^" S DUOUT=1 Q
|
|---|
| 108 | S SDWLSCPX=$S(X?1"Y".E:1,X?1"y".E:1,1:0)
|
|---|
| 109 | D DIE(SDWLDA,SDWLSCPX)
|
|---|
| 110 | Q
|
|---|
| 111 | ;
|
|---|
| 112 | DIE(DA,SDWLDIS) ; Update file 409.3 with SERVICE CONNECTED PRIORITY data.
|
|---|
| 113 | S DIE="^SDWL(409.3,"
|
|---|
| 114 | S DR="15///^S X=SDWLSCPX"
|
|---|
| 115 | D ^DIE
|
|---|
| 116 | Q
|
|---|
| 117 | HD ;HEADER
|
|---|
| 118 | ;
|
|---|
| 119 | W:$D(IOF) @IOF W !!,?80-$L("Wait List - SERVICE CONNECTED PRIORITY")\2,"Wait List - SERVICE CONNECTED PRIORITY",!!
|
|---|
| 120 | ;
|
|---|
| 121 | END ;QUIT OPTION
|
|---|
| 122 | K DIC,DIR,DR,DIE,SDWLDFN,DUOUT,SDWLSCP,SDWLSCPX,SDWLLIST,SDWLCN
|
|---|
| 123 | K SDWLCL,SDWSLCN,SDWLDA,SDWLDAPT,SDWLDATA,SDWLDFN,SDWLDISP,SDWLDUZ,SDWLEDT,SDWLERR,SDWLIN,SDWLNAM,SDWLOP,SDWLPRI
|
|---|
| 124 | K SDWLPROV,SDWLPS,SDWLRB,SDWLSC,SDWLSP,SDWLSS,SDWLST,SDWLTY,SDWLY,X,Y,SDWLHDR
|
|---|
| 125 | L Q
|
|---|
