SDWLMR.m

SDWLMR ;;IOFO BAY PINES/TEH - WAIT LIST - DISPOSITION WAIT LIST ENTRY;06/12/2002 ; 20 Aug 2002  2:10 PM

 ;;5.3;scheduling;**263**;AUG 13 1993

 ;

 ;

 ;******************************************************************

 ;                             CHANGE LOG

 ;                                               

 ;   DATE                        PATCH                   DESCRIPTION

 ;   ----                        -----                   -----------

 ;   

 ;   

 ;

 ;

 ;

 ;

EN ;

 ;OPTION HEADER

 N SDWLDA,SDWLDFN,SDWLCN,SDWLPS,SDWLY

 ;

 D HD

 ;

 ;PATIENT LOOK-UP FROM WAIT LIST PATIENT FILE (^SDWL(409.3,IEN,0).

 ;

 D PAT G END:'$D(SDWLDA),END:'$D(SDWLDFN)

 ;

 ;DISPLAY PATIENT DATA FROM ^SDWL(409.3,IEN,0).

 ;

 D DIS

 ;

 ;PROMPT USER FOR MEDICAL REVIEW ENTRY

 ;

 S SDWLPS=$S(SDWLCN>1:1,SDWLCN=1:2,1:1)

 I SDWLPS=1 S DIR(0)="FOA^^" S DIR("A")="Select Wait List (1-"_SDWLCN_")? "

 I SDWLPS=2 S DIR(0)="FOA^^" S DIR("A")="Edit this 'Entry'? 1// "

 W ! D ^DIR S SDWLY=Y W !

 I SDWLPS=2,'SDWLY S SDWLY=1

 I SDWLPS=1!(SDWLPS=2) I SDWLY?1N.N D

 .;

 .;CHECK FOR VALID ENTRY

 .;

 .I '$D(^TMP("SDWLD",$J,SDWLDFN,+SDWLY)) W !,"Invalid Entry " Q

 .S SDWLDA=$P($G(^TMP("SDWLD",$J,SDWLDFN,+SDWLY)),"~",2)

 .;

 .;LOCK DATA FILE

 .;

 .L +^SDWL(409.3,SDWLDA):5 I '$T W !,"Another Terminal is Editting this Entry! Try Later." S DUOUT=1

 I $D(DUOUT) Q

 ;

 ;GET PATIENT DATA FROM ^SDWL(409.3,IEN,0).

 ;

 D GETDATA

 ;

 ;ADVANCED DISPLAY OF PATIENT FIELDS IN ^SDWL(409.3,IEN,0)

 ;

 ;FIELD          DESCRIPTION                                     REQUIRED

 ;-----          -----------                                     --------

 ;

 ;      13               MEDICAL REVIEW COMPLETED

 ;      14               MEDICAL REVIEW DATE

 ;      15               MEDICAL REVIEW USER

 ;

 D DISP

 ;

 ;ENTER DISPOSITION

 ;

 D EDIT

 L -^SDWL(409.3,SDWLDA)

 ;

 Q

PAT ;PATIENT LOOK-UP

 ;

 S DIC(0)="AQEMNZ",DIC="^SDWL(409.3,",DIC("A")="ENTER WAIT LIST PATIENT NAME: " D ^DIC

 G PATEND:Y<0

 N DFN S (SDWLDFN,DFN)=$P(Y,U,2),SDWLDA=$P(Y,U,1)

 D 1^VADPT

PATEND Q

 ;

DIS ;DISPLAY DATA FOR PATIENT

 ;

 D EN^SDWLD(SDWLDFN,VA("PID"),VADM(1))

 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)

 I SDWLSP'="" S SDWLTYN=SDWLSP

 I SDWLSS'="" S SDWLTYN=SDWLSS

 I SDWLSC'="" S SDWLTYN=SDWLSC

 I SDWLST'="" S SDWLTYN=SDWLST

 S SDWLPROV=$P(SDWLDATA,U,12),SDWLDAPT=$P(SDWLDATA,U,16),SDWLST=$P(SDWLDATA,U,17),SDWLDUZ=DUZ,SDWLEDT=DT

 Q

DISP ;DISPLAY

 W !,"Wait List: ",$$EXTERNAL^DILFD(409.3,4,,SDWLTY),?40,"Date Entered: ",$$GET1^DIQ(409.3,SDWLDA,14,,,)

 W !,"Priority: ",$$GET1^DIQ(409.3,SDWLDA,SDWLPRI,,,),?20,"Institution: ",$$GET1^DIQ(409.3,SDWLDA,SDWLIN,,,)

 W ?40,"Entered By: ",$$GET1^DIQ(409.3,SDWLDA,9,,,)

 W !,"Requesting Provider: ",$$GET1^DIQ(409.3,SDWLDA,15,,,),?40,"Date Desired: ",$$GET1^DIQ(409.3,SDWLDA,16,,,)

 Q

 ;

EDIT ;ENTER/EDIT DISPOSITION

 ;

 S DIE="^SDWL(409.3,",DA=SDWLDA,DR="13Medical Record Documented " D ^DIE

 S DR="14Date Medical Review Completed " D ^DIE

 S DR="15Completed By " D ^DIE

 Q

 ;

HD ;HEADER

 ;

 W:$D(IOF) @IOF W !!,?80-$L("WAIT LIST - DISPOSITION PATIENT")\2,"WAIT LIST - DISPOSITION PATIENT",!!

 ;

END ;QUIT OPTION

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDWLMR   3466     printed  Feb 19, 2025@00:29:24                                                                                                                                                                                                      Page 2

SDWLMR    ;;IOFO BAY PINES/TEH - WAIT LIST - DISPOSITION WAIT LIST ENTRY;06/12/2002 ; 20 Aug 2002  2:10 PM

 +1       ;;5.3;scheduling;**263**;AUG 13 1993

 +2       ;

 +3       ;

 +4       ;******************************************************************

 +5       ;                             CHANGE LOG

 +6       ;                                               

 +7       ;   DATE                        PATCH                   DESCRIPTION

 +8       ;   ----                        -----                   -----------

 +9       ;   

 +10      ;   

 +11      ;

 +12      ;

 +13      ;

 +14      ;

EN        ;

 +1       ;OPTION HEADER

 +2        NEW SDWLDA,SDWLDFN,SDWLCN,SDWLPS,SDWLY

 +3       ;

 +4        DO HD

 +5       ;

 +6       ;PATIENT LOOK-UP FROM WAIT LIST PATIENT FILE (^SDWL(409.3,IEN,0).

 +7       ;

 +8        DO PAT

           if '$DATA(SDWLDA)

               GOTO END

           if '$DATA(SDWLDFN)

               GOTO END

 +9       ;

 +10      ;DISPLAY PATIENT DATA FROM ^SDWL(409.3,IEN,0).

 +11      ;

 +12       DO DIS

 +13      ;

 +14      ;PROMPT USER FOR MEDICAL REVIEW ENTRY

 +15      ;

 +16       SET SDWLPS=$SELECT(SDWLCN>1:1,SDWLCN=1:2,1:1)

 +17       IF SDWLPS=1

               SET DIR(0)="FOA^^"

               SET DIR("A")="Select Wait List (1-"_SDWLCN_")? "

 +18       IF SDWLPS=2

               SET DIR(0)="FOA^^"

               SET DIR("A")="Edit this 'Entry'? 1// "

 +19       WRITE !

           DO ^DIR

           SET SDWLY=Y

           WRITE !

 +20       IF SDWLPS=2

               IF 'SDWLY

                   SET SDWLY=1

 +21       IF SDWLPS=1!(SDWLPS=2)

               IF SDWLY?1N.N

                   Begin DoDot:1

 +22      ;

 +23      ;CHECK FOR VALID ENTRY

 +24      ;

 +25                   IF '$DATA(^TMP("SDWLD",$JOB,SDWLDFN,+SDWLY))

                           WRITE !,"Invalid Entry "

                           QUIT 

 +26                   SET SDWLDA=$PIECE($GET(^TMP("SDWLD",$JOB,SDWLDFN,+SDWLY)),"~",2)

 +27      ;

 +28      ;LOCK DATA FILE

 +29      ;

 +30                   LOCK +^SDWL(409.3,SDWLDA):5

                       IF '$TEST

                           WRITE !,"Another Terminal is Editting this Entry! Try Later."

                           SET DUOUT=1

                   End DoDot:1

 +31       IF $DATA(DUOUT)

               QUIT 

 +32      ;

 +33      ;GET PATIENT DATA FROM ^SDWL(409.3,IEN,0).

 +34      ;

 +35       DO GETDATA

 +36      ;

 +37      ;ADVANCED DISPLAY OF PATIENT FIELDS IN ^SDWL(409.3,IEN,0)

 +38      ;

 +39      ;FIELD          DESCRIPTION                                     REQUIRED

 +40      ;-----          -----------                                     --------

 +41      ;

 +42      ;      13               MEDICAL REVIEW COMPLETED

 +43      ;      14               MEDICAL REVIEW DATE

 +44      ;      15               MEDICAL REVIEW USER

 +45      ;

 +46       DO DISP

 +47      ;

 +48      ;ENTER DISPOSITION

 +49      ;

 +50       DO EDIT

 +51       LOCK -^SDWL(409.3,SDWLDA)

 +52      ;

 +53       QUIT 

PAT       ;PATIENT LOOK-UP

 +1       ;

 +2        SET DIC(0)="AQEMNZ"

           SET DIC="^SDWL(409.3,"

           SET DIC("A")="ENTER WAIT LIST PATIENT NAME: "

           DO ^DIC

 +3        if Y<0

               GOTO PATEND

 +4        NEW DFN

           SET (SDWLDFN,DFN)=$PIECE(Y,U,2)

           SET SDWLDA=$PIECE(Y,U,1)

 +5        DO 1^VADPT

PATEND     QUIT 

 +1       ;

DIS       ;DISPLAY DATA FOR PATIENT

 +1       ;

 +2        DO EN^SDWLD(SDWLDFN,VA("PID"),VADM(1))

 +3        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        IF SDWLSP'=""

               SET SDWLTYN=SDWLSP

 +6        IF SDWLSS'=""

               SET SDWLTYN=SDWLSS

 +7        IF SDWLSC'=""

               SET SDWLTYN=SDWLSC

 +8        IF SDWLST'=""

               SET SDWLTYN=SDWLST

 +9        SET SDWLPROV=$PIECE(SDWLDATA,U,12)

           SET SDWLDAPT=$PIECE(SDWLDATA,U,16)

           SET SDWLST=$PIECE(SDWLDATA,U,17)

           SET SDWLDUZ=DUZ

           SET SDWLEDT=DT

 +10       QUIT 

DISP      ;DISPLAY

 +1        WRITE !,"Wait List: ",$$EXTERNAL^DILFD(409.3,4,,SDWLTY),?40,"Date Entered: ",$$GET1^DIQ(409.3,SDWLDA,14,,,)

 +2        WRITE !,"Priority: ",$$GET1^DIQ(409.3,SDWLDA,SDWLPRI,,,),?20,"Institution: ",$$GET1^DIQ(409.3,SDWLDA,SDWLIN,,,)

 +3        WRITE ?40,"Entered By: ",$$GET1^DIQ(409.3,SDWLDA,9,,,)

 +4        WRITE !,"Requesting Provider: ",$$GET1^DIQ(409.3,SDWLDA,15,,,),?40,"Date Desired: ",$$GET1^DIQ(409.3,SDWLDA,16,,,)

 +5        QUIT 

 +6       ;

EDIT      ;ENTER/EDIT DISPOSITION

 +1       ;

 +2        SET DIE="^SDWL(409.3,"

           SET DA=SDWLDA

           SET DR="13Medical Record Documented "

           DO ^DIE

 +3        SET DR="14Date Medical Review Completed "

           DO ^DIE

 +4        SET DR="15Completed By "

           DO ^DIE

 +5        QUIT 

 +6       ;

HD        ;HEADER

 +1       ;

 +2        if $DATA(IOF)

               WRITE @IOF

           WRITE !!,?80-$LENGTH("WAIT LIST - DISPOSITION PATIENT")\2,"WAIT LIST - DISPOSITION PATIENT",!!

 +3       ;

END       ;QUIT OPTION

 +1        QUIT