| [613] | 1 | 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
|
|---|
| 2 | ;;5.3;scheduling;**446**;AUG 13 1993;Build 77
|
|---|
| 3 | ;
|
|---|
| 4 | ;modified SDWLE
|
|---|
| 5 | ;******************************************************************
|
|---|
| 6 | ; CHANGE LOG
|
|---|
| 7 | ;
|
|---|
| 8 | ; DATE PATCH DESCRIPTION
|
|---|
| 9 | ; ---- ----- -----------
|
|---|
| 10 | ; 09JUN2005 446 Inter-Facility Transfer.
|
|---|
| 11 | ;
|
|---|
| 12 | ;
|
|---|
| 13 | EN ;ENTRY POINT - INTIALIZE VARIABLES
|
|---|
| 14 | N DTOUT,%,SDWLHDR,SDWLNAM,SDWLSSN,SDWLTEM,SDWLPOS,VADM,VA,X
|
|---|
| 15 | I $D(SDWLOPT),SDWLOPT G OPT
|
|---|
| 16 | I $D(SDWLLIST),SDWLLIST,$D(DFN),DFN<0 K SDWLLIST
|
|---|
| 17 | 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
|
|---|
| 18 | K ^TMP("SDWLD",$J) D HD
|
|---|
| 19 | D PAT G END:DFN<0
|
|---|
| 20 | OPT ;
|
|---|
| 21 | N SDWLDFN,SDWLNEW,SDWLERR,SDWLCN,SDWLWTE,SDWLPS
|
|---|
| 22 | S SDWLDFN=DFN
|
|---|
| 23 | D 1^VADPT
|
|---|
| 24 | S (SDWLTEM,SDWLPOS)=0
|
|---|
| 25 | EN1 S SDWLNEW=0,SDWLERR=0,SDWLCN=0,SDWLWTE=0
|
|---|
| 26 | D DIS
|
|---|
| 27 | I $D(^SDWL(409.3,"B",DFN)),'SDWLCN W !!,"PATIENT: ",VADM(1),?40,VA("PID")
|
|---|
| 28 | S SDWLPS=$S(SDWLCN>1:1,SDWLCN=1:2,1:3)
|
|---|
| 29 | I $D(SDWLOPT),SDWLOPT,SDWLPS=3 S X="Y" G ENO
|
|---|
| 30 | 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."
|
|---|
| 31 | I SDWLPS=2 S DIR(0)="FOA^^" S DIR("A")="Select Wait List (1) or '^' to Quit ? ",DIR("?")="Enter a '1' or '^' to Quit."
|
|---|
| 32 | 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// "
|
|---|
| 33 | W ! D ^DIR W ! K DIR
|
|---|
| 34 | G END:$D(DUOUT),END:$D(DTOUT)
|
|---|
| 35 | I SDWLPS=1 D G END:SDWLERR=1 I SDWLERR=2 W *7," ??" G EN1
|
|---|
| 36 | .S SDWLERR=$S(X="":2,X["^":1,$D(^TMP("SDWLD",$J,DFN,+X)):0,1:2) Q
|
|---|
| 37 | I SDWLPS=2 D G END:SDWLERR=1 I SDWLERR=2 W *7," ??" G EN1
|
|---|
| 38 | .S SDWLERR=$S(X="":2,$D(DUOUT):1,X["^":1,$D(^TMP("SDWLD",$J,DFN,+X)):0,1:2) Q
|
|---|
| 39 | ENO I SDWLPS=3 D G EN:SDWLERR=1 I SDWLERR=2 G EN1
|
|---|
| 40 | .S SDWLERR=$S(X="":2,X?1"Y".E:2,X?1"y".E:2,$D(DUOUT):1,X["^":1,1:1)
|
|---|
| 41 | .I SDWLERR=1 K DFN Q
|
|---|
| 42 | N SDCAN I SDWLPS=1!(SDWLPS=2),X?1N.N D
|
|---|
| 43 | .N DA
|
|---|
| 44 | .S (DA,SDWLDA)=$P($G(^TMP("SDWLD",$J,DFN,+X)),"~",2),SDWLEDIT=""
|
|---|
| 45 | .;
|
|---|
| 46 | .;LOCK DATA FILE
|
|---|
| 47 | .;
|
|---|
| 48 | .L +^SDWL(409.3,SDWLDA):5 I '$T W !,"ANOTHER TERMINAL IS EDITING THIS ENTRY. TRY LATER." S DUOUT=1
|
|---|
| 49 | .I $D(DUOUT) Q
|
|---|
| 50 | .D EN^SDWLE10
|
|---|
| 51 | .D EDITC(SDWLDA,.SDCAN) L -^SDWL(409.3,SDWLDA) S SDWLERR=1 K SDWLEDIT
|
|---|
| 52 | .I SDCAN W !,"This process has been canceled."
|
|---|
| 53 | .E W !,"The requested entry has been opened."
|
|---|
| 54 | D END
|
|---|
| 55 | Q
|
|---|
| 56 | END ;
|
|---|
| 57 | D EN^SDWLKIL
|
|---|
| 58 | Q
|
|---|
| 59 | ;
|
|---|
| 60 | ;
|
|---|
| 61 | PAT ;SELECT PATIENT
|
|---|
| 62 | N DIC
|
|---|
| 63 | S DIC(0)="EMNZAQ",DIC=2 D ^DIC S (SDWLDFN,DFN)=$P(Y,U,1) G PAT1:DFN<0
|
|---|
| 64 | S X=$$GET1^DIQ(2,DFN_",",".351") I X'="" W !,*7,"PATIENT'S DATE OF DEATH HAS BEEN RECORDED" G PAT
|
|---|
| 65 | S SDWLSSN=$G(VA("PID")),SDWLNAM=$G(VA(1))
|
|---|
| 66 | PAT1 K VADM,VAIN,VAERR,VA Q
|
|---|
| 67 | ;
|
|---|
| 68 | DIS ;DISPLAY DATA FOR PATIENT
|
|---|
| 69 | ;
|
|---|
| 70 | S SDWLHDR="Wait List OPEN CLOSED ENTRY"
|
|---|
| 71 | D EN^SDWLD(DFN,VA("PID"),VADM(1),"C")
|
|---|
| 72 | D PCM^SDWLE1,PCMD^SDWLE1
|
|---|
| 73 | Q
|
|---|
| 74 | ;
|
|---|
| 75 | EDITC(SDWLDA,SDCAN) ;edit closed entry
|
|---|
| 76 | N DA,DIE,DIR,DR,SDWLCM,Y
|
|---|
| 77 | W !,"Reopen comment required to open this entry. Reopen reason: O - Other.",!
|
|---|
| 78 | ; Reopen Comment
|
|---|
| 79 | S Y=0,SDCAN=0
|
|---|
| 80 | F Q:$L(Y)>10!(Y="^") S DIR(0)="FAOU^^",DIR("A")="Comments or '^' to cancel this process: ",DIR("B")="" D ^DIR D
|
|---|
| 81 | .I $L(Y)<11 W !,"At least 10 char comment required" Q
|
|---|
| 82 | .I X="^" Q
|
|---|
| 83 | I Y="^" S SDCAN=1 Q
|
|---|
| 84 | S SDWLCM=$E(Y,1,70)
|
|---|
| 85 | S DIE="^SDWL(409.3,",DA=SDWLDA,DR="23////^S X=""O""" D ^DIE
|
|---|
| 86 | S DR="28///^S X=$G(DUZ);29////^S X=""O""" D ^DIE ; REOPEN REASON - OTHER
|
|---|
| 87 | S DR="19///@;20///@;21///@;30///^S X=SDWLCM" D ^DIE
|
|---|
| 88 | S DR="13///@;13.1////@;13.2///@;13.3///@;13.4///@;13.5///@;13.6///@;13.8///@;13.7///@" D ^DIE ;SD/467
|
|---|
| 89 | Q
|
|---|
| 90 | SB1 S X=$$GET1^DIQ(2,DFN_",",".351") I X'="" S DUOUT=""
|
|---|
| 91 | Q
|
|---|
| 92 | HD W:$D(IOF) @IOF W !,?80-$L("Scheduling/PCMM Open Closed Wait Entry")\2,"Scheduling/PCMM Open Closed Wait List Entry",!!
|
|---|
| 93 | I $D(DFN),DFN'="",'$D(^SDWL(409.3,"B",DFN)),$D(SDWLLIST),SDWLLIST D
|
|---|
| 94 | .W !!,"PATIENT: ",VADM(1),?40,VA("PID")
|
|---|
| 95 | Q
|
|---|
