SDWLSCPE.m

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 ---SDWLSCPE   4617     printed  Mar 13, 2025@22:08:30                                                                                                                                                                                                    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