SDWLD ;;IOFO BAY PINES/TEH - DISPLAY PENDING APPOINTMENTS;06/12/2002 ; 20 Aug 2002 2:10 PM ; Compiled September 25, 2006 13:39:47
;;5.3;scheduling;**263,454,417,446**;AUG 13 1993;Build 77
;
;
;*********************************************************
; CHANGE LOG
;
; DATE PATCH DESCRIPTION
; ---- ----- -----------
;
;
; ;ENTRY POINT FOR OPTION CALL
;
; SDWLDFN = PATIENT IEN
; SDWLSSN = PATIENT SSN
; SDWLNAM = PATIENT NAME
;
; ;Patch SD*5.3*417 Display Team when displaying Position.
;
EN(SDWLDFN,SDWLSSN,SDWLNAM,SDTP) ;ENTRY POINT - INTIALIZE VARIABLES
;SDTP (optional) - EWL ENTRY STATUS
I $G(SDTP)="" S SDTP="O"
I SDTP'="O"&(SDTP'="C") Q ;
K ^TMP("SDWLD",$J) I $D(^SDWL(409.3,"B",SDWLDFN)) D
.D GETDATA(SDTP)
.Q:'SDWLCNT
.D HD1
.D DIS
.D HD2
.D DISPD
Q
GETDATA(SDTP) ;GET PATIENT DATA FROM SD WAIT LIST FILE (^SDWL(409.3)
;SDTP - EWL entry status
; O - open
; C - closed
N SDWLWTE S SDWLCNT=0,SDWLWTE=0 D
.I SDTP="C" N SDDENT,SDBEG,SDEND D SEL1(.SDDENT) D I +SDDENT=0 Q ;return 'begin^end' entry day
..I +SDDENT=0 W !,"Entry Date range required for closed EWL selection" Q
..S SDBEG=$P(SDDENT,U),SDEND=$P(SDDENT,U,2)
.S SDWLDA=0 F S SDWLDA=$O(^SDWL(409.3,"B",SDWLDFN,SDWLDA)) Q:SDWLDA="" D
..S SDWLDATA=$G(^SDWL(409.3,SDWLDA,0))
..;
..I $P(SDWLDATA,U,17)'[SDTP Q
..I $D(^SDWL(409.3,"ST",SDWLDA)) S SDWLWTE=1
..I $D(^SDWL(409.3,"SP",SDWLDA)) S SDWLPOS=1
..S SDWLDT=$P(SDWLDATA,U,2) I SDTP="C" I SDWLDT<SDBEG!(SDWLDT>SDEND) Q
..S SDWLCL=$P(SDWLDATA,U,4) I SDWLDT="" Q
..S SDWLCLN="" I $D(^SC(+SDWLCL,0)) S SDWLCLN=$E($P($G(^SC(SDWLCL,0)),U,2),1,6) I SDWLCLN="" Q
..S SDWLCNT=SDWLCNT+1,^TMP("SDWLD",$J,SDWLDFN,SDWLCNT)=SDWLDATA_"~"_SDWLDA,^TMP("SDWLD",$J,"B",SDWLCNT,SDWLDFN,SDWLDT,SDWLDA)=""
..K SDWLDATA
Q
SEL1(SDDENT) K DIR,%DT(0) S SDWLDISC="",%DT="AE",%DT("A")="Start with Date Entered: " D ^%DT N SDWLBDT S SDWLBDT=Y I Y<1 S SDDENT="^" Q
S %DT(0)=SDWLBDT,%DT("A")="End with Date Entered: " D ^%DT D SEL1(.SDDENT):Y<1 S SDWLEDT=Y K %DT(0),%DT("A")
S SDDENT=SDWLBDT_U_SDWLEDT
DIS ;DISPLAY PATIENT DATA
W !,?5,SDWLNAM,?35,SDWLSSN,!
I $G(SDTP)'="C" W !,"Patient Currently is on Waiting List for the Following",!
E W !,"Patient is on closed Waiting List for the Following",!
Q
DISPD ;DISPLAY WAIT LIST DATA
S (SDWLDT,SDWLCNT,SDWLCN)=""
F S SDWLCNT=$O(^TMP("SDWLD",$J,SDWLDFN,SDWLCNT)) Q:SDWLCNT="" D
.S X=$G(^TMP("SDWLD",$J,SDWLDFN,SDWLCNT)),SDWLDA=$P(X,"~",2),SDWLIN=$P(X,U,3),SDWLCL=$P(X,U,4),SDWLTY=$P(X,U,5),SDWLPRI=$P(X,U,11)
.N SDWLDSP,SDWLSCO,SDWLSPO,SDWLSSO,SDWLSTO S SDWLDSP=$P(X,U,17)
.S SDWLDT=$P(X,U,2),SDWLTYN=$$EXTERNAL^DILFD(409.3,4,,SDWLTY),SDWLPRIN=$$EXTERNAL^DILFD(409.3,10,,SDWLPRI)
.S SDWLSTO=$P(X,U,22),SDWLSPO=$P(X,U,23),SDWLSSO=$P(X,U,24),SDWLSCO=$P(X,U,25)
.S SDWLST=$P(X,U,6),SDWLSP=$P(X,U,7),SDWLSS=$P(X,U,8),SDWLSC=$P(X,U,9),SDWLWR="" D
..I SDWLST'="" S SDWLWR=$$EXTERNAL^DILFD(409.3,5,,SDWLST)
..I SDWLSTO["Y" S SDWLWR="OPEN"
..;SD*5.3*417
..I SDWLSP'="" S SDWLWR=$$EXTERNAL^DILFD(409.3,6,,SDWLSP) D
...I $D(^SCTM(404.57,SDWLSP)) S SDWLX=$P($G(^SCTM(404.57,SDWLSP,0)),U,2),SDWLX=$E($P($G(^SCTM(404.51,SDWLX,0)),U,1),1,10),SDWLWR=SDWLWR_" ("_SDWLX_")"
..I SDWLSPO["Y" S SDWLWR="OPEN"
..I SDWLSS'="" S SDWLWR=$$EXTERNAL^DILFD(409.3,7,,SDWLSS)
..I SDWLSSO["Y" S SDWLWR="OPEN"
..I SDWLSC'="" S SDWLWR=$$EXTERNAL^DILFD(409.3,8,,SDWLSC)
..I SDWLSCO["^" S SDWLWR="OPEN"
.N YY,MM,DD S YY=$E(SDWLDT,1,3)+1700,YY=$E(YY,3,4),MM=$E(SDWLDT,4,5),DD=$E(SDWLDT,6,7),SDWLDTP=MM_DD_YY
.S SDWLCLN="" I $D(^SC(+SDWLCL,0)) S SDWLCLN=$$GET1^DIQ(44,SDWLCL_",",1,,)
.S SDWLINN=$E($P($G(^DIC(4,+SDWLIN,0)),U,1),1,8)
.N SDWLDIS S SDWLDIS=$P($G(^SDWL(409.3,SDWLDA,"DIS")),U,3),SDWLDISN=$$EXTERNAL^DILFD(409.3,21,,SDWLDIS)
.S SDWLCN=SDWLCN+1
.W !,$J(SDWLCN,2)_".",?5,$E(SDWLTYN,1,14),?22,SDWLPRI,?25,$E(SDWLWR,1,19),?51,$E(SDWLINN,1,14) W:$D(SDWLDISC) ?67,SDWLDSP
.W ?73,SDWLDTP
K SDWLDT,SDWLIN,SDWLCL,SDWLTY,SDWLPRI,SDWLPRIN,SDWLTYN,SDWLST,SDWLSP,SDWLSS,SDWLSC,SDWLCLN,SDWLDTP,SDWLINN,SDWLDA,SDWLDISN
K SDWLPRI,SDWLWR
Q
HD1 ;TOF HEADER INFORMATION
I '$D(SDWLHDR) S SDWLHDR="Wait List Display"
W !!,?80-$L(SDWLHDR_$S($D(SDWLOP):" - "_SDWLOP,1:""))\2,SDWLHDR W:$D(SDWLOP) " - ",SDWLOP ;SD*5.3*454 removed page feed
W !
Q
HD2 ;DATA HEADER
W !," #",?4,"Wait List Type",?22,"P",?26,"Waiting",?51,"Institution" W:$D(SDWLDISC) ?65,"Status"
W ?74,"Date"
W !,?28,"For",?73,"Entered"
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDWLD 4719 printed Oct 16, 2024@19:02:43 Page 2
SDWLD ;;IOFO BAY PINES/TEH - DISPLAY PENDING APPOINTMENTS;06/12/2002 ; 20 Aug 2002 2:10 PM ; Compiled September 25, 2006 13:39:47
+1 ;;5.3;scheduling;**263,454,417,446**;AUG 13 1993;Build 77
+2 ;
+3 ;
+4 ;*********************************************************
+5 ; CHANGE LOG
+6 ;
+7 ; DATE PATCH DESCRIPTION
+8 ; ---- ----- -----------
+9 ;
+10 ;
+11 ; ;ENTRY POINT FOR OPTION CALL
+12 ;
+13 ; SDWLDFN = PATIENT IEN
+14 ; SDWLSSN = PATIENT SSN
+15 ; SDWLNAM = PATIENT NAME
+16 ;
+17 ; ;Patch SD*5.3*417 Display Team when displaying Position.
+18 ;
EN(SDWLDFN,SDWLSSN,SDWLNAM,SDTP) ;ENTRY POINT - INTIALIZE VARIABLES
+1 ;SDTP (optional) - EWL ENTRY STATUS
+2 IF $GET(SDTP)=""
SET SDTP="O"
+3 ;
IF SDTP'="O"&(SDTP'="C")
QUIT
+4 KILL ^TMP("SDWLD",$JOB)
IF $DATA(^SDWL(409.3,"B",SDWLDFN))
Begin DoDot:1
+5 DO GETDATA(SDTP)
+6 if 'SDWLCNT
QUIT
+7 DO HD1
+8 DO DIS
+9 DO HD2
+10 DO DISPD
End DoDot:1
+11 QUIT
GETDATA(SDTP) ;GET PATIENT DATA FROM SD WAIT LIST FILE (^SDWL(409.3)
+1 ;SDTP - EWL entry status
+2 ; O - open
+3 ; C - closed
+4 NEW SDWLWTE
SET SDWLCNT=0
SET SDWLWTE=0
Begin DoDot:1
+5 ;return 'begin^end' entry day
IF SDTP="C"
NEW SDDENT,SDBEG,SDEND
DO SEL1(.SDDENT)
Begin DoDot:2
+6 IF +SDDENT=0
WRITE !,"Entry Date range required for closed EWL selection"
QUIT
+7 SET SDBEG=$PIECE(SDDENT,U)
SET SDEND=$PIECE(SDDENT,U,2)
End DoDot:2
IF +SDDENT=0
QUIT
+8 SET SDWLDA=0
FOR
SET SDWLDA=$ORDER(^SDWL(409.3,"B",SDWLDFN,SDWLDA))
if SDWLDA=""
QUIT
Begin DoDot:2
+9 SET SDWLDATA=$GET(^SDWL(409.3,SDWLDA,0))
+10 ;
+11 IF $PIECE(SDWLDATA,U,17)'[SDTP
QUIT
+12 IF $DATA(^SDWL(409.3,"ST",SDWLDA))
SET SDWLWTE=1
+13 IF $DATA(^SDWL(409.3,"SP",SDWLDA))
SET SDWLPOS=1
+14 SET SDWLDT=$PIECE(SDWLDATA,U,2)
IF SDTP="C"
IF SDWLDT<SDBEG!(SDWLDT>SDEND)
QUIT
+15 SET SDWLCL=$PIECE(SDWLDATA,U,4)
IF SDWLDT=""
QUIT
+16 SET SDWLCLN=""
IF $DATA(^SC(+SDWLCL,0))
SET SDWLCLN=$EXTRACT($PIECE($GET(^SC(SDWLCL,0)),U,2),1,6)
IF SDWLCLN=""
QUIT
+17 SET SDWLCNT=SDWLCNT+1
SET ^TMP("SDWLD",$JOB,SDWLDFN,SDWLCNT)=SDWLDATA_"~"_SDWLDA
SET ^TMP("SDWLD",$JOB,"B",SDWLCNT,SDWLDFN,SDWLDT,SDWLDA)=""
+18 KILL SDWLDATA
End DoDot:2
End DoDot:1
+19 QUIT
SEL1(SDDENT) KILL DIR,%DT(0)
SET SDWLDISC=""
SET %DT="AE"
SET %DT("A")="Start with Date Entered: "
DO ^%DT
NEW SDWLBDT
SET SDWLBDT=Y
IF Y<1
SET SDDENT="^"
QUIT
+1 SET %DT(0)=SDWLBDT
SET %DT("A")="End with Date Entered: "
DO ^%DT
if Y<1
DO SEL1(.SDDENT)
SET SDWLEDT=Y
KILL %DT(0),%DT("A")
+2 SET SDDENT=SDWLBDT_U_SDWLEDT
DIS ;DISPLAY PATIENT DATA
+1 WRITE !,?5,SDWLNAM,?35,SDWLSSN,!
+2 IF $GET(SDTP)'="C"
WRITE !,"Patient Currently is on Waiting List for the Following",!
+3 IF '$TEST
WRITE !,"Patient is on closed Waiting List for the Following",!
+4 QUIT
DISPD ;DISPLAY WAIT LIST DATA
+1 SET (SDWLDT,SDWLCNT,SDWLCN)=""
+2 FOR
SET SDWLCNT=$ORDER(^TMP("SDWLD",$JOB,SDWLDFN,SDWLCNT))
if SDWLCNT=""
QUIT
Begin DoDot:1
+3 SET X=$GET(^TMP("SDWLD",$JOB,SDWLDFN,SDWLCNT))
SET SDWLDA=$PIECE(X,"~",2)
SET SDWLIN=$PIECE(X,U,3)
SET SDWLCL=$PIECE(X,U,4)
SET SDWLTY=$PIECE(X,U,5)
SET SDWLPRI=$PIECE(X,U,11)
+4 NEW SDWLDSP,SDWLSCO,SDWLSPO,SDWLSSO,SDWLSTO
SET SDWLDSP=$PIECE(X,U,17)
+5 SET SDWLDT=$PIECE(X,U,2)
SET SDWLTYN=$$EXTERNAL^DILFD(409.3,4,,SDWLTY)
SET SDWLPRIN=$$EXTERNAL^DILFD(409.3,10,,SDWLPRI)
+6 SET SDWLSTO=$PIECE(X,U,22)
SET SDWLSPO=$PIECE(X,U,23)
SET SDWLSSO=$PIECE(X,U,24)
SET SDWLSCO=$PIECE(X,U,25)
+7 SET SDWLST=$PIECE(X,U,6)
SET SDWLSP=$PIECE(X,U,7)
SET SDWLSS=$PIECE(X,U,8)
SET SDWLSC=$PIECE(X,U,9)
SET SDWLWR=""
Begin DoDot:2
+8 IF SDWLST'=""
SET SDWLWR=$$EXTERNAL^DILFD(409.3,5,,SDWLST)
+9 IF SDWLSTO["Y"
SET SDWLWR="OPEN"
+10 ;SD*5.3*417
+11 IF SDWLSP'=""
SET SDWLWR=$$EXTERNAL^DILFD(409.3,6,,SDWLSP)
Begin DoDot:3
+12 IF $DATA(^SCTM(404.57,SDWLSP))
SET SDWLX=$PIECE($GET(^SCTM(404.57,SDWLSP,0)),U,2)
SET SDWLX=$EXTRACT($PIECE($GET(^SCTM(404.51,SDWLX,0)),U,1),1,10)
SET SDWLWR=SDWLWR_" ("_SDWLX_")"
End DoDot:3
+13 IF SDWLSPO["Y"
SET SDWLWR="OPEN"
+14 IF SDWLSS'=""
SET SDWLWR=$$EXTERNAL^DILFD(409.3,7,,SDWLSS)
+15 IF SDWLSSO["Y"
SET SDWLWR="OPEN"
+16 IF SDWLSC'=""
SET SDWLWR=$$EXTERNAL^DILFD(409.3,8,,SDWLSC)
+17 IF SDWLSCO["^"
SET SDWLWR="OPEN"
End DoDot:2
+18 NEW YY,MM,DD
SET YY=$EXTRACT(SDWLDT,1,3)+1700
SET YY=$EXTRACT(YY,3,4)
SET MM=$EXTRACT(SDWLDT,4,5)
SET DD=$EXTRACT(SDWLDT,6,7)
SET SDWLDTP=MM_DD_YY
+19 SET SDWLCLN=""
IF $DATA(^SC(+SDWLCL,0))
SET SDWLCLN=$$GET1^DIQ(44,SDWLCL_",",1,,)
+20 SET SDWLINN=$EXTRACT($PIECE($GET(^DIC(4,+SDWLIN,0)),U,1),1,8)
+21 NEW SDWLDIS
SET SDWLDIS=$PIECE($GET(^SDWL(409.3,SDWLDA,"DIS")),U,3)
SET SDWLDISN=$$EXTERNAL^DILFD(409.3,21,,SDWLDIS)
+22 SET SDWLCN=SDWLCN+1
+23 WRITE !,$JUSTIFY(SDWLCN,2)_".",?5,$EXTRACT(SDWLTYN,1,14),?22,SDWLPRI,?25,$EXTRACT(SDWLWR,1,19),?51,$EXTRACT(SDWLINN,1,14)
if $DATA(SDWLDISC)
WRITE ?67,SDWLDSP
+24 WRITE ?73,SDWLDTP
End DoDot:1
+25 KILL SDWLDT,SDWLIN,SDWLCL,SDWLTY,SDWLPRI,SDWLPRIN,SDWLTYN,SDWLST,SDWLSP,SDWLSS,SDWLSC,SDWLCLN,SDWLDTP,SDWLINN,SDWLDA,SDWLDISN
+26 KILL SDWLPRI,SDWLWR
+27 QUIT
HD1 ;TOF HEADER INFORMATION
+1 IF '$DATA(SDWLHDR)
SET SDWLHDR="Wait List Display"
+2 ;SD*5.3*454 removed page feed
WRITE !!,?80-$LENGTH(SDWLHDR_$SELECT($DATA(SDWLOP):" - "_SDWLOP,1:""))\2,SDWLHDR
if $DATA(SDWLOP)
WRITE " - ",SDWLOP
+3 WRITE !
+4 QUIT
HD2 ;DATA HEADER
+1 WRITE !," #",?4,"Wait List Type",?22,"P",?26,"Waiting",?51,"Institution"
if $DATA(SDWLDISC)
WRITE ?65,"Status"
+2 WRITE ?74,"Date"
+3 WRITE !,?28,"For",?73,"Entered"
+4 QUIT
