- SDWLE ;BPOI/TEH - WAITING LIST-ENTER/EDIT;06/12/2002
- ;;5.3;scheduling;**263,415,446,524,1015**;08/13/93;Build 21
- ;
- ;
- ;******************************************************************
- ; CHANGE LOG
- ;
- ; DATE PATCH DESCRIPTION
- ; ---- ----- -----------
- ; 09JUN2005 446 Inter-Facility Transfer.
- ;
- ;
- EN ;ENTRY POINT - INTIALIZE VARIABLES
- N DTOUT,%
- 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 S SDWLPCMM=0,SDWLERR=0 I $D(SDWLOPT),SDWLOPT D
- .S %=2 W !,"DO YOU WISH TO PLACE THIS PATIENT ON A WAITING LIST " D YN^DICN
- .I %=-1!(%=2) S SDWLERR=1 Q
- I $D(SDWLOPT),SDWLOPT,SDWLERR Q
- S SDWLDFN=DFN
- D 1^VADPT
- S (SDWLTEM,SDWLPOS)=0
- EN1 N SDWLNEW,SDWLERR,SDWLCN,SDWLWTE S SDWLNEW=0,SDWLERR=0,SDWLCN=0,SDWLWTE=0
- G:$$EN^SDWLE6(SDWLDFN,.SDWLERR) EN2 ; OG ; SD*5.3*446 ; Inter-facility transfer
- 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 Enter 'N' for New or '^' to Quit ? ",DIR("?")="Enter a Valid Number or 'N' for New."
- I SDWLPS=2 S DIR(0)="FOA^^" S DIR("A")="Select Wait List (1) or Enter 'N' for New or '^' to Quit ? ",DIR("?")="Enter a '1' or 'N' for New."
- I SDWLPS=3 S DIR(0)="YAO^^S X=""Y""" S DIR("A")="Patient is not on Waiting List. Do you wish to Add Patient? Yes// "
- W ! D ^DIR W ! K DIR
- G END:$D(DUOUT),END:$D(DTOUT)
- I SDWLPS=1 D G EN3:SDWLERR=1 I SDWLERR=2 W *7," ??" G EN1
- .S SDWLERR=$S(X?1"N".E:0,X?1"n".E:0,X="":2,$D(DUOUT):1,X["^":1,$D(^TMP("SDWLD",$J,DFN,+X)):0,1:2) Q
- I SDWLPS=2 D G EN3:SDWLERR=1 I SDWLERR=2 W *7," ??" G EN1
- .S SDWLERR=$S(X?1"N".E:0,X?1"n".E:0,X="":2,$D(DUOUT):1,X["^":1,$D(^TMP("SDWLD",$J,DFN,+X)):0,1:2) Q
- ENO I SDWLPS=3 D G EN3:SDWLERR=1 I SDWLERR=2 W *7," ??" G EN1
- .S SDWLERR=$S(X?1"N".E:1,X?1"n".E:1,X="":0,X?1"Y".E:0,X?1"y".E:0,$D(DUOUT):1,X["^":1,1:2) Q
- I SDWLPS=1!(SDWLPS=2),X?1N.N D
- .N DA,SDWLDA S (DA,SDWLDA)=$P($G(^TMP("SDWLD",$J,DFN,+X)),"~",2),SDWLEDIT=""
- .;
- .;LOCK DATA FILE
- .;
- .L +^SDWL(409.3,DA):5 I '$T W !,"ANOTHER TERMINAL IS EDITING THIS ENTRY. TRY LATER." S DUOUT=1
- .I $D(DUOUT) Q
- .N SDWLINNM,SDWLSTN ; OG ; This and the following six lines added for patch 415
- .I $$GETTRN^SDWLIFT1(SDWLDA,.SDWLINNM,.SDWLSTN) D S DUOUT=1 Q
- ..N SDWLMSG,SDWLI
- ..S SDWLMSG(0)=1,SDWLMSG(SDWLMSG(0),0)="This entry is the subject of a transfer to "_SDWLINNM_" ("_SDWLSTN_"). Editing inhibited."
- ..I $L(SDWLMSG(SDWLMSG(0),0))>80 D COL80^SDWLIFT(.SDWLMSG)
- ..F SDWLI=1:1:SDWLMSG(0) W !,SDWLMSG(SDWLI,0)
- ..Q
- .D EN^SDWLE10
- .D EDIT W !!,"Editing is Completed" S SDWLERR=1 K SDWLEDIT
- G END:SDWLERR
- I SDWLPS=1!(SDWLPS=2),X?1"N".E!(X?1"n".E) D NEW,EDIT S SDWLNEW="" G EN2
- I SDWLPS=3 D NEW,EDIT S SDWLNEW=""
- EN2 I $D(SDWLNEW),'$D(DUOUT),'SDWLERR W !!,?15,"*** Patient has been added to Wait List ***",!
- K SDWLNEW,DUOUT
- ;
- ;UNLOCK FILE AND KILL LOCAL VARIABLES
- ;
- I $D(SDWLDA) L -^SDWL(409.3,SDWLDA)
- ;-exit logic
- EN3 D END^SDWLE113
- Q
- END D END^SDWLE113
- D EN^SDWLKIL
- Q
- ;
- ;
- PAT ;SELECT PATIENT
- ;
- 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 Enter/Edit"
- D EN^SDWLD(DFN,VA("PID"),VADM(1))
- D PCM^SDWLE1,PCMD^SDWLE1
- Q
- ;
- NEW ;
- D NEW^SDWLE11
- Q
- ;
- EDIT ;
- D EN^SDWLE111 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
- I SDWLTYE=4 D ED4 K DIR,DIE,DIC,DR Q
- I SDWLTYE=3 D ED3 K DIR,DIE,DIC,DR Q
- I SDWLTYE=2 D ED2 K DIR,DIE,DIC,DR Q
- I SDWLTYE=1 D ED1 K DIR,DIE,DIC,DR Q
- Q
- ED1 ;-team
- I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
- D EN^SDWLE3 I '$D(DUOUT) D EN^SDWLE113 Q
- Q
- ED2 ;-position
- I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
- D EN^SDWLE5 I '$D(DUOUT) D EN^SDWLE113 Q
- Q
- ED3 ;-specialty
- D EN^SDWLE2 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
- D EN^SDWLE110 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
- I '$D(DUOUT) D EN^SDWLE113
- D END^SDWLE113
- Q
- ED4 ;-clinic
- D EN^SDWLE4 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
- D EN^SDWLE110 I $D(DUOUT) D END^SDWLE113:'$D(SDWLEDIT) Q
- I '$D(DUOUT) D EN^SDWLE113
- D END^SDWLE113
- Q
- ;
- ED5 D END^SDWLE113
- Q
- SB1 S X=$$GET1^DIQ(2,DFN_",",".351") I X'="" S DUOUT=""
- Q
- HD W:$D(IOF) @IOF W !,?80-$L("Scheduling/PCMM Enter/Edit Wait List")\2,"Scheduling/PCMM Enter/Edit Wait List",!!
- I $D(DFN),DFN'="",'$D(^SDWL(409.3,"B",DFN)),$D(SDWLLIST),SDWLLIST D
- .W !!,"PATIENT: ",VADM(1),?40,VA("PID")
- Q
- SDWLE ;BPOI/TEH - WAITING LIST-ENTER/EDIT;06/12/2002
- +1 ;;5.3;scheduling;**263,415,446,524,1015**;08/13/93;Build 21
- +2 ;
- +3 ;
- +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,%
- +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 SET SDWLPCMM=0
- SET SDWLERR=0
- IF $DATA(SDWLOPT)
- IF SDWLOPT
- Begin DoDot:1
- +1 SET %=2
- WRITE !,"DO YOU WISH TO PLACE THIS PATIENT ON A WAITING LIST "
- DO YN^DICN
- +2 IF %=-1!(%=2)
- SET SDWLERR=1
- QUIT
- End DoDot:1
- +3 IF $DATA(SDWLOPT)
- IF SDWLOPT
- IF SDWLERR
- QUIT
- +4 SET SDWLDFN=DFN
- +5 DO 1^VADPT
- +6 SET (SDWLTEM,SDWLPOS)=0
- EN1 NEW SDWLNEW,SDWLERR,SDWLCN,SDWLWTE
- SET SDWLNEW=0
- SET SDWLERR=0
- SET SDWLCN=0
- SET SDWLWTE=0
- +1 ; OG ; SD*5.3*446 ; Inter-facility transfer
- IF $$EN^SDWLE6(SDWLDFN,.SDWLERR)
- GOTO EN2
- +2 DO DIS
- +3 IF $DATA(^SDWL(409.3,"B",DFN))
- IF 'SDWLCN
- WRITE !!,"PATIENT: ",VADM(1),?40,VA("PID")
- +4 SET SDWLPS=$SELECT(SDWLCN>1:1,SDWLCN=1:2,1:3)
- +5 IF $DATA(SDWLOPT)
- IF SDWLOPT
- IF SDWLPS=3
- SET X="Y"
- GOTO ENO
- +6 IF SDWLPS=1
- SET DIR(0)="FOA^^"
- SET DIR("A")="Select Wait List (1-"_SDWLCN_") or Enter 'N' for New or '^' to Quit ? "
- SET DIR("?")="Enter a Valid Number or 'N' for New."
- +7 IF SDWLPS=2
- SET DIR(0)="FOA^^"
- SET DIR("A")="Select Wait List (1) or Enter 'N' for New or '^' to Quit ? "
- SET DIR("?")="Enter a '1' or 'N' for New."
- +8 IF SDWLPS=3
- SET DIR(0)="YAO^^S X=""Y"""
- SET DIR("A")="Patient is not on Waiting List. Do you wish to Add Patient? Yes// "
- +9 WRITE !
- DO ^DIR
- WRITE !
- KILL DIR
- +10 IF $DATA(DUOUT)
- GOTO END
- IF $DATA(DTOUT)
- GOTO END
- +11 IF SDWLPS=1
- Begin DoDot:1
- +12 SET SDWLERR=$SELECT(X?1"N".E:0,X?1"n".E:0,X="":2,$DATA(DUOUT):1,X["^":1,$DATA(^TMP("SDWLD",$JOB,DFN,+X)):0,1:2)
- QUIT
- End DoDot:1
- IF SDWLERR=1
- GOTO EN3
- IF SDWLERR=2
- WRITE *7," ??"
- GOTO EN1
- +13 IF SDWLPS=2
- Begin DoDot:1
- +14 SET SDWLERR=$SELECT(X?1"N".E:0,X?1"n".E:0,X="":2,$DATA(DUOUT):1,X["^":1,$DATA(^TMP("SDWLD",$JOB,DFN,+X)):0,1:2)
- QUIT
- End DoDot:1
- IF SDWLERR=1
- GOTO EN3
- IF SDWLERR=2
- WRITE *7," ??"
- GOTO EN1
- ENO IF SDWLPS=3
- Begin DoDot:1
- +1 SET SDWLERR=$SELECT(X?1"N".E:1,X?1"n".E:1,X="":0,X?1"Y".E:0,X?1"y".E:0,$DATA(DUOUT):1,X["^":1,1:2)
- QUIT
- End DoDot:1
- IF SDWLERR=1
- GOTO EN3
- IF SDWLERR=2
- WRITE *7," ??"
- GOTO EN1
- +2 IF SDWLPS=1!(SDWLPS=2)
- IF X?1N.N
- Begin DoDot:1
- +3 NEW DA,SDWLDA
- SET (DA,SDWLDA)=$PIECE($GET(^TMP("SDWLD",$JOB,DFN,+X)),"~",2)
- SET SDWLEDIT=""
- +4 ;
- +5 ;LOCK DATA FILE
- +6 ;
- +7 LOCK +^SDWL(409.3,DA):5
- IF '$TEST
- WRITE !,"ANOTHER TERMINAL IS EDITING THIS ENTRY. TRY LATER."
- SET DUOUT=1
- +8 IF $DATA(DUOUT)
- QUIT
- +9 ; OG ; This and the following six lines added for patch 415
- NEW SDWLINNM,SDWLSTN
- +10 IF $$GETTRN^SDWLIFT1(SDWLDA,.SDWLINNM,.SDWLSTN)
- Begin DoDot:2
- +11 NEW SDWLMSG,SDWLI
- +12 SET SDWLMSG(0)=1
- SET SDWLMSG(SDWLMSG(0),0)="This entry is the subject of a transfer to "_SDWLINNM_" ("_SDWLSTN_"). Editing inhibited."
- +13 IF $LENGTH(SDWLMSG(SDWLMSG(0),0))>80
- DO COL80^SDWLIFT(.SDWLMSG)
- +14 FOR SDWLI=1:1:SDWLMSG(0)
- WRITE !,SDWLMSG(SDWLI,0)
- +15 QUIT
- End DoDot:2
- SET DUOUT=1
- QUIT
- +16 DO EN^SDWLE10
- +17 DO EDIT
- WRITE !!,"Editing is Completed"
- SET SDWLERR=1
- KILL SDWLEDIT
- End DoDot:1
- +18 IF SDWLERR
- GOTO END
- +19 IF SDWLPS=1!(SDWLPS=2)
- IF X?1"N".E!(X?1"n".E)
- DO NEW
- DO EDIT
- SET SDWLNEW=""
- GOTO EN2
- +20 IF SDWLPS=3
- DO NEW
- DO EDIT
- SET SDWLNEW=""
- EN2 IF $DATA(SDWLNEW)
- IF '$DATA(DUOUT)
- IF 'SDWLERR
- WRITE !!,?15,"*** Patient has been added to Wait List ***",!
- +1 KILL SDWLNEW,DUOUT
- +2 ;
- +3 ;UNLOCK FILE AND KILL LOCAL VARIABLES
- +4 ;
- +5 IF $DATA(SDWLDA)
- LOCK -^SDWL(409.3,SDWLDA)
- +6 ;-exit logic
- EN3 DO END^SDWLE113
- +1 QUIT
- END DO END^SDWLE113
- +1 DO EN^SDWLKIL
- +2 QUIT
- +3 ;
- +4 ;
- PAT ;SELECT PATIENT
- +1 ;
- +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 Enter/Edit"
- +3 DO EN^SDWLD(DFN,VA("PID"),VADM(1))
- +4 DO PCM^SDWLE1
- DO PCMD^SDWLE1
- +5 QUIT
- +6 ;
- NEW ;
- +1 DO NEW^SDWLE11
- +2 QUIT
- +3 ;
- EDIT ;
- +1 DO EN^SDWLE111
- IF $DATA(DUOUT)
- IF '$DATA(SDWLEDIT)
- DO END^SDWLE113
- QUIT
- +2 IF SDWLTYE=4
- DO ED4
- KILL DIR,DIE,DIC,DR
- QUIT
- +3 IF SDWLTYE=3
- DO ED3
- KILL DIR,DIE,DIC,DR
- QUIT
- +4 IF SDWLTYE=2
- DO ED2
- KILL DIR,DIE,DIC,DR
- QUIT
- +5 IF SDWLTYE=1
- DO ED1
- KILL DIR,DIE,DIC,DR
- QUIT
- +6 QUIT
- ED1 ;-team
- +1 IF $DATA(DUOUT)
- IF '$DATA(SDWLEDIT)
- DO END^SDWLE113
- QUIT
- +2 DO EN^SDWLE3
- IF '$DATA(DUOUT)
- DO EN^SDWLE113
- QUIT
- +3 QUIT
- ED2 ;-position
- +1 IF $DATA(DUOUT)
- IF '$DATA(SDWLEDIT)
- DO END^SDWLE113
- QUIT
- +2 DO EN^SDWLE5
- IF '$DATA(DUOUT)
- DO EN^SDWLE113
- QUIT
- +3 QUIT
- ED3 ;-specialty
- +1 DO EN^SDWLE2
- IF $DATA(DUOUT)
- IF '$DATA(SDWLEDIT)
- DO END^SDWLE113
- QUIT
- +2 DO EN^SDWLE110
- IF $DATA(DUOUT)
- IF '$DATA(SDWLEDIT)
- DO END^SDWLE113
- QUIT
- +3 IF '$DATA(DUOUT)
- DO EN^SDWLE113
- +4 DO END^SDWLE113
- +5 QUIT
- ED4 ;-clinic
- +1 DO EN^SDWLE4
- IF $DATA(DUOUT)
- IF '$DATA(SDWLEDIT)
- DO END^SDWLE113
- QUIT
- +2 DO EN^SDWLE110
- IF $DATA(DUOUT)
- IF '$DATA(SDWLEDIT)
- DO END^SDWLE113
- QUIT
- +3 IF '$DATA(DUOUT)
- DO EN^SDWLE113
- +4 DO END^SDWLE113
- +5 QUIT
- +6 ;
- ED5 DO END^SDWLE113
- +1 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 Enter/Edit Wait List")\2,"Scheduling/PCMM Enter/Edit Wait List",!!
- +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
