98 lines
4.5 KiB
Mathematica
98 lines
4.5 KiB
Mathematica
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
|