source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDWLD.m@ 1397

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