SDWLEC.m

SDWLEC ;;IOFO BAY PINES/ESW - CLOSED WAITING LIST-EDIT;06/12/2002 ; 20 Aug 2002  2:10 PM  ; Compiled April 16, 2007 10:48:37

 ;;5.3;scheduling;**446,1015**;AUG 13 1993;Build 21

 ;

 ;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

 I $D(SDWLOPT),SDWLOPT G OPT

 I $D(SDWLLIST),SDWLLIST,$D(DFN),DFN<0 K SDWLLIST

 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=0,SDWLERR=0,SDWLCN=0,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):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 DA,DIE,DIR,DR,SDWLCM,Y

 W !,"Reopen comment required to open this entry. Reopen reason: O - Other.",!

 ; Reopen Comment

 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

 S SDWLCM=$E(Y,1,70)

 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

SDWLEC    ;;IOFO BAY PINES/ESW - CLOSED WAITING LIST-EDIT;06/12/2002 ; 20 Aug 2002  2:10 PM  ; Compiled April 16, 2007 10:48:37

 +1       ;;5.3;scheduling;**446,1015**;AUG 13 1993;Build 21

 +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

 +2        IF $DATA(SDWLOPT)

               IF SDWLOPT

                   GOTO OPT

 +3        IF $DATA(SDWLLIST)

               IF SDWLLIST

                   IF $DATA(DFN)

                       IF DFN<0

                           KILL SDWLLIST

 +4        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

 +5        KILL ^TMP("SDWLD",$JOB)

           DO HD

 +6        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=0

           SET SDWLERR=0

           SET SDWLCN=0

           SET 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

 +5                    SET (DA,SDWLDA)=$PIECE($GET(^TMP("SDWLD",$JOB,DFN,+X)),"~",2)

                       SET SDWLEDIT=""

 +6       ;

 +7       ;LOCK DATA FILE

 +8       ;

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

                       IF '$TEST

                           WRITE !,"ANOTHER TERMINAL IS EDITING THIS ENTRY. TRY LATER."

                           SET DUOUT=1

 +10                   IF $DATA(DUOUT)

                           QUIT 

 +11                   DO EN^SDWLE10

 +12                   DO EDITC(SDWLDA,.SDCAN)

                       LOCK -^SDWL(409.3,SDWLDA)

                       SET SDWLERR=1

                       KILL SDWLEDIT

 +13                   IF SDCAN

                           WRITE !,"This process has been canceled."

 +14                  IF '$TEST

                           WRITE !,"The requested entry has been opened."

                   End DoDot:1

 +15       DO END

 +16       QUIT 

END       ;

 +1        DO EN^SDWLKIL

 +2        QUIT 

 +3       ;

 +4       ;

PAT       ;SELECT PATIENT

 +1        NEW DIC

 +2        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 DA,DIE,DIR,DR,SDWLCM,Y

 +2        WRITE !,"Reopen comment required to open this entry. Reopen reason: O - Other.",!

 +3       ; Reopen Comment

 +4        SET Y=0

           SET SDCAN=0

 +5        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

 +6                IF $LENGTH(Y)<11

                       WRITE !,"At least 10 char comment required"

                       QUIT 

 +7                IF X="^"

                       QUIT 

               End DoDot:1

 +8        IF Y="^"

               SET SDCAN=1

               QUIT 

 +9        SET SDWLCM=$EXTRACT(Y,1,70)

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

           SET DA=SDWLDA

           SET DR="23////^S X=""O"""

           DO ^DIE

 +11      ; REOPEN REASON - OTHER

           SET DR="28///^S X=$G(DUZ);29////^S X=""O"""

           DO ^DIE

 +12       SET DR="19///@;20///@;21///@;30///^S X=SDWLCM"

           DO ^DIE

 +13      ;SD/467

           SET DR="13///@;13.1////@;13.2///@;13.3///@;13.4///@;13.5///@;13.6///@;13.8///@;13.7///@"

           DO ^DIE

 +14       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