- SDWLEC ;;IOFO BAY PINES/ESW - CLOSED WAITING LIST-EDIT;06/12/2002; Compiled April 17, 2009 14:22:44
- ;;5.3;scheduling;**446,539**;AUG 13 1993;Build 24
- ;
- ;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,SDWLPS
- I $D(SDWLOPT),SDWLOPT G OPT
- I $D(SDWLLIST),SDWLLIST,$D(DFN),DFN<0 K SDWLLIST
- N SDWLDFN
- 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,SDWLERR,SDWLCN,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):$S($G(DILOCKTM)>5:DILOCKTM,1: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 SDCLR S SDCLR=$P(^SDWL(409.3,SDWLDA,"DIS"),U,3) I SDCLR="ER"!(SDCLR="D") S SDCAN=1 D S SDCAN=1 Q
- .I SDCLR="ER" W !," ENTERED IN ERROR - NOT TO BE OPENED"
- W !,"Reopen comment required to open this entry. Reopen reason: O - Other.",!
- ;Reopen comment
- N DIR,Y 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
- N SDWLCM S SDWLCM=$E(Y,1,70)
- N DIE,DR,DA
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLEC 4438 printed Mar 13, 2025@22:07:41 Page 2
- SDWLEC ;;IOFO BAY PINES/ESW - CLOSED WAITING LIST-EDIT;06/12/2002; Compiled April 17, 2009 14:22:44
- +1 ;;5.3;scheduling;**446,539**;AUG 13 1993;Build 24
- +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,SDWLPS
- +2 IF $DATA(SDWLOPT)
- IF SDWLOPT
- GOTO OPT
- +3 IF $DATA(SDWLLIST)
- IF SDWLLIST
- IF $DATA(DFN)
- IF DFN<0
- KILL SDWLLIST
- +4 NEW SDWLDFN
- +5 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
- +6 KILL ^TMP("SDWLD",$JOB)
- DO HD
- +7 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,SDWLERR,SDWLCN,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
- SET (DA,SDWLDA)=$PIECE($GET(^TMP("SDWLD",$JOB,DFN,+X)),"~",2)
- SET SDWLEDIT=""
- +5 ;
- +6 ;LOCK DATA FILE
- +7 ;
- +8 LOCK +^SDWL(409.3,SDWLDA):$SELECT($GET(DILOCKTM)>5:DILOCKTM,1:5)
- IF '$TEST
- WRITE !,"ANOTHER TERMINAL IS EDITING THIS ENTRY. TRY LATER."
- SET DUOUT=1
- +9 IF $DATA(DUOUT)
- QUIT
- +10 DO EN^SDWLE10
- +11 DO EDITC(SDWLDA,.SDCAN)
- LOCK -^SDWL(409.3,SDWLDA)
- SET SDWLERR=1
- KILL SDWLEDIT
- +12 IF SDCAN
- WRITE !,"This process has been canceled."
- +13 IF '$TEST
- WRITE !,"The requested entry has been opened."
- End DoDot:1
- +14 DO END
- +15 QUIT
- END ;
- +1 DO EN^SDWLKIL
- +2 QUIT
- +3 ;
- +4 ;
- PAT ;SELECT PATIENT
- +1 ;
- +2 NEW DIC
- 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 SDCLR
- SET SDCLR=$PIECE(^SDWL(409.3,SDWLDA,"DIS"),U,3)
- IF SDCLR="ER"!(SDCLR="D")
- SET SDCAN=1
- Begin DoDot:1
- +2 IF SDCLR="ER"
- WRITE !," ENTERED IN ERROR - NOT TO BE OPENED"
- End DoDot:1
- SET SDCAN=1
- QUIT
- +3 WRITE !,"Reopen comment required to open this entry. Reopen reason: O - Other.",!
- +4 ;Reopen comment
- +5 NEW DIR,Y
- SET Y=0
- SET SDCAN=0
- +6 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
- +7 IF $LENGTH(Y)<11
- WRITE !,"At least 10 char comment required"
- QUIT
- +8 IF X="^"
- QUIT
- End DoDot:1
- +9 IF Y="^"
- SET SDCAN=1
- QUIT
- +10 NEW SDWLCM
- SET SDWLCM=$EXTRACT(Y,1,70)
- +11 NEW DIE,DR,DA
- +12 SET DIE="^SDWL(409.3,"
- SET DA=SDWLDA
- SET DR="23////^S X=""O"""
- DO ^DIE
- +13 ; REOPEN REASON - OTHER
- SET DR="28///^S X=$G(DUZ);29////^S X=""O"""
- DO ^DIE
- +14 SET DR="19///@;20///@;21///@;30///^S X=SDWLCM"
- DO ^DIE
- +15 ;SD/467
- SET DR="13///@;13.1////@;13.2///@;13.3///@;13.4///@;13.5///@;13.6///@;13.8///@;13.7///@"
- DO ^DIE
- +16 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
