- 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 Feb 19, 2025@00:28:50 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
