Ignore:
Timestamp:
Dec 4, 2009, 12:11:15 AM (14 years ago)
Author:
George Lilly
Message:

revised back to 6/30/08 version

File:
1 edited

Legend:

Unmodified
Added
Removed

  • WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SDWLI.m

    r613 r623  
    1 SDWLI   ;BPOI/TEH - DISPLAY PENDING APPOINTMENTS;6/1/05
    2         ;;5.3;scheduling;**263,327,394,446,524**;08/13/93;Build 29
    3         ;
    4         ;
    5         ;******************************************************************
    6         ;                             CHANGE LOG
    7         ;                                               
    8         ;   DATE               PATCH          DESCRIPTION
    9         ;   ----             -----             -----------
    10         ;   04/22/2005      SD*5.3*327  DISPLAY APPOINTMENT INFORMATION
    11         ;   04/22/2005      SD*5.3*327  UNDEFINED ERROR HD+1
    12         ;   08/07/2006      SD*5.3*446  proceed only when DFN defined
    13         ;   04/14/2006      SD*5.3*446  INTER-FACILITY TRANSFER
    14         ;
    15         ;
    16 EN      ;NEW AND INITIALIZE VARIABLES
    17         S SDWLERR=0
    18         I $D(SDWLLIST),SDWLLIST D  Q:SDWLERR
    19         .I '$G(DFN) S SDWLERR=1 Q
    20         .I $D(DFN),DFN'="",'$D(^SDWL(409.3,"B",DFN)) D HD W *7,!,"This Patient has NO entries on the Electronic Wait List." S DIR(0)="E" D ^DIR S DUOUT=1 Q
    21         I $D(DUOUT) G END
    22         I 'SDWLERR,$D(SDWLLIST),SDWLLIST D 1^VADPT,DEM^VADPT S SDWLDFN=DFN D HD K DIR,DIC,DR,DIE,VADM S (SDWLBDT,SDWLEDT)="" K ^TMP("SDWLI",$J) G EN1
    23         K DIR,DIC,DR,DIE,VADM
    24         S (SDWLBDT,SDWLEDT)="" K ^TMP("SDWLI",$J)
    25         ;
    26         ;OPTION HEADER
    27         ;
    28         D HD
    29         ;
    30         ;PATIENT LOOK-UP FROM WAIT LIST PATIENT FILE (^SDWL(409.3,IEN,0).
    31         ;
    32         D SEL G EN:$D(DUOUT)
    33         D PAT Q:'$D(SDWLDFN)
    34         G END:SDWLDFN<0,END:SDWLDFN=""
    35         Q:$D(DUOUT)
    36 EN1     K DIR,DIC,DR,DIE,SDWLDRG
    37         D GETFILE
    38         D DISP G EN:'$D(DUOUT)
    39         D END
    40         Q
    41 PAT     ;PATIENT LOOK-UP
    42         ;PATCH SD*5.3*524 - SET DIC("S") FOR SCREEN OF OPEN/CLOSED ENTRIES
    43         S DIC("S")="I $D(SDWLY),SDWLY,$P(^SDWL(409.3,+Y,0),U,17)=""O"""
    44         S DIC(0)="EMNQA",DIC=409.3 D ^DIC S (SDWLDFN,DFN)=$P(Y,U,2)
    45         G PATEND:SDWLDFN=""
    46         Q:Y<0
    47         Q:$D(DUOUT)
    48         D 1^VADPT
    49 PATEND  Q
    50         ;
    51         ;PROMPT FOR DISPLAY 'OPEN' WAITING LIST ONLY OR PROMPT FOR BEGINNING AND ENDING DATES
    52         ;
    53 SEL     K SDWLDRG S DIR(0)="Y" S DIR("A")="Do You Want to View Only 'OPEN' Wait Lists",DIR("B")="YES"
    54         S DIR("?")="'Yes' for 'Open' and these Patient Record have not been dispositioned and 'No' for all Records."
    55         W ! D ^DIR S SDWLY=Y W !
    56         I X["^" S DUOUT=1
    57         I SDWLY=0 D SEL1
    58         Q
    59 SEL1    K DIR,%DT(0) S SDWLDISC="",%DT="AE",%DT("A")="Start with Date Entered: " D ^%DT G SEL:Y<1 S SDWLBDT=Y
    60         S %DT(0)=SDWLBDT,%DT("A")="End with Date Entered: " D ^%DT G SEL1:Y<1 S SDWLEDT=Y,SDWLDRG="" K %DT(0),%DT("A")
    61         Q
    62         ;
    63 GETFILE ;GET DATA - OPTIONAL DATE RANGE IF SDWLDBT AND SDWLEDT VALID DATE RANGE
    64         ;
    65         K ^TMP("SDWLI",$J),SDWLDISX S SDWLDA=0,SDWLCNT=0 F  S SDWLDA=$O(^SDWL(409.3,"B",SDWLDFN,SDWLDA)) Q:SDWLDA=""  D
    66         .S SDWLDATA=$G(^SDWL(409.3,SDWLDA,0)) I '$D(SDWLDRG),$P(SDWLDATA,U,17)["C" Q
    67         .I '$P(SDWLDATA,U,3) Q
    68         .N SDWLAPP S SDWLAPP="" I $D(^SDWL(409.3,SDWLDA,"SDAPT")) S SDWLAPP=^("SDAPT") D  ;app data
    69         ..S SDWLAPP=SDWLAPP_"~"_$P(SDWLDATA,U,23)
    70         .N SDOP,SDOP1 S SDOP="" I $D(^SDWL(409.3,SDWLDA,1)) S SDOP=^(1),SDOP1=$$GET1^DIQ(409.3,SDWLDA_",",29),$P(SDOP,U)=SDOP1
    71         .I $D(^SDWL(409.3,SDWLDA,"DIS")) D
    72         ..S SDWLDISX=$G(^SDWL(409.3,SDWLDA,"DIS")),SDWLDIS=$P(SDWLDISX,U,3),SDWLDDUZ=$P(SDWLDISX,U,2)
    73         ..S SDWLDDT=$P(^SDWL(409.3,SDWLDA,"DIS"),U,1)
    74         ..S SDWLDIDT="" I SDWLDDT'="" S SDWLDIDT=$E(SDWLDDT,4,5)_"/"_$E(SDWLDDT,6,7)_"/"_$E(SDWLDDT,2,3)
    75         .I $D(^SDWL(409.3,SDWLDA,"DNR")) D
    76         ..S SDREM=$G(^SDWL(409.3,SDWLDA,"DNR")) S SDREMD=$P(SDWLDATA,U,14),SDREMU=$P(SDWLDATA,U,15)
    77         ..S SDREMDD="" I SDREMD'="" S SDREMDD=$E(SDREMD,4,5)_"/"_$E(SDREMD,6,7)_"/"_$E(SDREMD,2,3)
    78         ..S SDREMR=$$GET1^DIQ(409.3,SDWLDA_",",18),SDREMRC=$$GET1^DIQ(409.3,SDWLDA_",",18.1,"I")
    79         .S SDWLST=$P(SDWLDATA,U,6),SDWLSP=$P(SDWLDATA,U,7),SDWLSS=$P(SDWLDATA,U,8),SDWLSC=$P(SDWLDATA,U,9),SDWLDT=$P(SDWLDATA,U,2)
    80         .S SDWLPROV=$P(SDWLDATA,U,13) I $D(SDWLDRG) D  I SDNOK Q
    81         ..S SDNOK=0
    82         ..I SDWLDT<SDWLBDT!(SDWLDT>SDWLEDT) S SDNOK=1 Q
    83         .;
    84         .;IF STATUS IS CLOSED DO NOT DISPLAY RECORD
    85         .;
    86         .S SDWLCNT=SDWLCNT+1,^TMP("SDWLI",$J,SDWLCNT)=SDWLDATA_"~"_SDWLDA
    87         .I $D(SDWLDISX) D
    88         ..S ^TMP("SDWLI",$J,SDWLCNT,"DIS")=SDWLDIS_"^"_SDWLDDUZ_"^"_SDWLDIDT
    89         ..I SDWLAPP>0 S ^TMP("SDWLI",$J,SDWLCNT,"SDAPT")=SDWLAPP
    90         ..I SDOP'="" S ^TMP("SDWLI",$J,SDWLCNT,"SDOP")=SDOP
    91         .I $D(SDREM) D
    92         ..S ^TMP("SDWLI",$J,SDWLCNT,"REM")=SDREMR_U_SDREMRC_U_SDREMU_U_SDREMDD
    93         .S ^TMP("SDWLI",$J)=SDWLCNT
    94         .K SDWLDISX,SDREM
    95         Q
    96         ;
    97 DISP    ;Display Wait List Data
    98         S (SDWLDT,SDWLCNT,SDWLCN)="",SDWLCT=$G(^TMP("SDWLI",$J)) I 'SDWLCT W !!,"No 'OPEN' Wait List Records to Display.",!! K DIR S DIR(0)="E" D ^DIR S DUOUT="" Q
    99         F  S SDWLCNT=$O(^TMP("SDWLI",$J,SDWLCNT)) Q:SDWLCNT=""  D  I $D(DUOUT) Q
    100         .N SDWLDISX,SDWLR,SDWLCLPT
    101         .I $D(^TMP("SDWLI",$J,SDWLCNT,"DIS")) S SDWLDISX=$G(^TMP("SDWLI",$J,SDWLCNT,"DIS"))
    102         .I $D(^TMP("SDWLI",$J,SDWLCNT,"REM")) S SDWLR=$G(^TMP("SDWLI",$J,SDWLCNT,"REM")) D
    103         ..S SDREMR=$P(SDWLR,U),SDREMRC=$P(SDWLR,U,2),SDREMU=$P(SDWLR,U,3),SDREMDD=$P(SDWLR,U,4)
    104         .S X=$G(^TMP("SDWLI",$J,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)
    105         .S SDWLTYP=$S(SDWLTY=1:$P(X,U,6),SDWLTY=2:$P(X,U,7),SDWLTY=3:$P(X,U,8),SDWLTY=4:$P(X,U,9),1:"")
    106         .S SDWLTYN=$S(SDWLTY=1:5,SDWLTY=2:6,SDWLTY=3:7,SDWLTY=4:8),SDWLCOM=$P($P(X,U,18),"~",1)
    107         .S SDWLDUZ=$P(X,U,10),SDWLPRV=$P(X,U,12),SDWLPROV=$P(X,U,13),SDWLX=$P(X,"~",3) D
    108         ..I $D(SDWLDISX) S SDWLDIS=$P(SDWLDISX,U,1),SDWLDDUZ=$P(SDWLDISX,U,2),SDWLDIDT=$P(SDWLDISX,U,3)
    109         .S SDWLDT=$P(X,U,2),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
    110         .S SDWLDTD=$P(X,U,16),YY=$E(SDWLDTD,1,3)+1700,YY=$E(YY,3,4),MM=$E(SDWLDTD,4,5),DD=$E(SDWLDTD,6,7),SDWLDTD=MM_"/"_DD_"/"_YY
    111         .;PATCH SD*5.3*394 See Note.
    112         .N SDWLSCP
    113         .S SDWLSCP=+$P($G(^SDWL(409.3,SDWLDA,"SC")),U,2)
    114         .W !,"# ",$J(SDWLCNT,3),!
    115         .W !,"Wait List - ",$$EXTERNAL^DILFD(409.3,4,,SDWLTY),?55,"Date Entered - ",SDWLDTP
    116         .W !,?15 S X=$$EXTERNAL^DILFD(409.3,SDWLTYN,,SDWLTYP) W X
    117         .S SDWLP=0 I SDWLPRI W !,"Priority - ",$$EXTERNAL^DILFD(409.3,10,,SDWLPRI) S SDWLP=1
    118         .I $D(SDWLSCP) W !,"Service Connected Priority - ",$$EXTERNAL^DILFD(409.3,15,,SDWLSCP)
    119         .W:SDWLP ?15 W:'SDWLP ! W "Institution - ",$$EXTERNAL^DILFD(409.3,2,,SDWLIN)
    120         .W !,"Entered by - " S X=$$EXTERNAL^DILFD(409.3,9,,SDWLDUZ) W X
    121         .S SDWRB=0 I SDWLPRV W !,"Requested By - ",$$EXTERNAL^DILFD(409.3,11,,SDWLPRV),?55,"Date Desired - ",SDWLDTD
    122         .I SDWLPRV=1 W !,"Provider - ",$$EXTERNAL^DILFD(409.3,12,,SDWLPROV)
    123         .I $D(SDWLCOM),SDWLCOM'="" W !,"Comments - ",SDWLCOM
    124         .I $D(^TMP("SDWLI",$J,SDWLCNT,"SDOP")) N SDOP S SDOP=^("SDOP") W !,"Reopen Reason: ",$P(SDOP,U) D
    125         ..I $P(SDOP,U,2)'="" W !,"Reopen comment: ",$P(SDOP,U,2)
    126         .I $D(^TMP("SDWLI",$J,SDWLCNT,"REM")) W !,"Non Removal Reason - ",SDREMR,!,"Non Remove Reason entered by - ",$$GET1^DIQ(200,SDREMU_",",.01,"I") D
    127         ..I $L(SDREMRC)>0 W !,"Non Removal Comment - ",SDREMRC
    128         ..W !,"Non Removal entry date - ",SDREMDD
    129         .I $D(^TMP("SDWLI",$J,SDWLCNT,"DIS")) W !,"Disposition - ",$$EXTERNAL^DILFD(409.3,21,,SDWLDIS),?51,"Disposition Date - ",SDWLDIDT D
    130         ..W !,"Dispositioned by - ",$$EXTERNAL^DILFD(409.3,20,,SDWLDDUZ)
    131         .I $D(^TMP("SDWLI",$J,SDWLCNT,"SDAPT")) N SDAP S SDAP=^("SDAPT") D
    132         ..W !,"Appointment scheduled for " S Y=$P(SDAP,"~",2) D DD^%DT W Y
    133         ..W !?3,"Made on: " S Y=+SDAP D DD^%DT W Y,?30,"For clinic: " N SDC S SDC=$P(SDAP,U,2) S SDC=$$GET1^DIQ(44,SDC_",",.01) W SDC
    134         ..N SDAIN S SDAIN=$P(SDAP,U,3),SDAIN=$$GET1^DIQ(4,SDAIN_",",.01)
    135         ..W !?3,"Appt Institution: ",SDAIN
    136         ..N SDCR S SDCR=$P(SDAP,U,4),SDCR=$$GET1^DIQ(40.7,SDCR_",",.01)
    137         ..W ?40,"Appt Specialty: ",SDCR
    138         ..N SAPS S SAPS=$P(SDAP,U,8),SAPS=$P(SAPS,"~") I SAPS="CC" W !,"Appointment Status: Canceled by Clinic"
    139         .S SDWLCLPT=$$GET1^DIQ(409.3,SDWLDA,37,"I")  ; SD*5.3*446
    140         .D:SDWLCLPT  ; SD*5.3*446
    141         ..W !,"Clinic changed from: ",$$GET1^DIQ(409.3,SDWLCLPT,8)
    142         ..W:SDWLIN'=$$GET1^DIQ(409.3,SDWLCLPT,2,"I") " (",$$GET1^DIQ(409.3,SDWLCLPT,2),")"
    143         ..Q
    144         .; Inter-facility Transfer. SD*5.3*446
    145         .I $$GETTRN^SDWLIFT1(SDWLDA,.SDWLINNM,.SDWLSTN) D ENS^%ZISS W !,IOINHI,"In transfer to ",SDWLINNM," (",SDWLSTN,")",IOINORM D KILL^%ZISS
    146         .D GETS^DIQ(409.3,SDWLDA,"32;33;34;36;38;39","TMP")
    147         .K SDWLIN,SDWLCL,SDWLTY,SDWLPRI,SDWLDUZ,SDWLPRV,SDWLDT,SDWLDTD,SDWLDIS,SDWLDIDT,SDWLTYN,SDWLCOM,SDWLPROV,SDWLDISX,DIR,DIE,DR,SDWLINNM,SDWLSTN
    148         .W !,"*****",! K DIR S DIR(0)="E" D ^DIR  D
    149         ..I X["^" S DUOUT=1 Q
    150         ..I 'Y S DUOUT=1 Q
    151         ..D HD
    152         Q
    153 HD      ;Header
    154         W:$D(IOF) @IOF W !!,?80-$L("Wait List - Inquiry")\2,"Wait List - Inquiry ",!
    155         ;SD*5.3*327 - Correct undefined.
    156         I '$D(SDWLDFN) W !! Q
    157         N DFN S DFN=SDWLDFN D DEM^VADPT
    158         W:$D(VADM) !,VADM(1),?40 I $D(VA("PID")) W VA("PID")
    159         W !!
    160         K DUOUT
    161         Q
    162 END     ;
    163         K DIR,DIC,DR,DIE,SDWLDFN,DUOUT
    164         K SDNOK,SDWLBDT,SDWLCL,SDWLCN,SDWLCNT,SDWLCOM,SDWLCT,SDWLDA,SDWLDATA,SDWLDDT,SDWLDDUZ,SDWLDFN,SDWLDIDT,SDWLDIS,SDWLDISX
    165         K SDWLDRG,SDWLDT,SDWLDTD,SDWLDTP,SDWLDUZ,SDLWEDT,SDWLIN,SDLWP,SDWLPRI,SDWLPROV,SDLWPRV,SDWLSC,SDWLSP,SDWLSS,SDLWST,SDWLTY
    166         K SDWLTYN,SDSWLTYP,SDLWX,SDWLY,SDWRB,SDWLBDT,SDWLDISC,SDWLERR,SDWLPRON,SDXSCAT,SDWLP,SDWLTYP
    167         K SDREMD,SDREMDD,SDREMR,SDREMRC,SDREMU,MM,SDWLEDT,SDWLLIST,SDWLST,SDWLX,VA,X,Y,YY
    168         Q
     1SDWLI ;IOFO BAY PINES/TEH - DISPLAY PENDING APPOINTMENTS ; 6/1/05 12:56pm  ; Compiled April 16, 2007 10:00:47
     2 ;;5.3;scheduling;**263,327,394,446**;AUG 13 1993;Build 77
     3 ;
     4 ;
     5 ;******************************************************************
     6 ;                             CHANGE LOG
     7 ;                                               
     8 ;   DATE               PATCH          DESCRIPTION
     9 ;   ----             -----             -----------
     10 ;   04/22/2005      SD*5.3*327  DISPLAY APPOINTMENT INFORMATION
     11 ;   04/22/2005      SD*5.3*327  UNDEFINED ERROR HD+1
     12 ;   08/07/2006      SD*5.3*446  proceed only when DFN defined
     13 ;   04/14/2006      SD*5.3*446  INTER-FACILITY TRANSFER
     14 ;
     15 ;
     16EN ;NEW AND INITIALIZE VARIABLES
     17 S SDWLERR=0
     18 I $D(SDWLLIST),SDWLLIST D  Q:SDWLERR
     19 .I '$G(DFN) S SDWLERR=1 Q
     20 .I $D(DFN),DFN'="",'$D(^SDWL(409.3,"B",DFN)) D HD W *7,!,"This Patient has NO entries on the Electronic Wait List." S DIR(0)="E" D ^DIR S DUOUT=1 Q
     21 I $D(DUOUT) G END
     22 I 'SDWLERR,$D(SDWLLIST),SDWLLIST D 1^VADPT,DEM^VADPT S SDWLDFN=DFN D HD K DIR,DIC,DR,DIE,VADM S (SDWLBDT,SDWLEDT)="" K ^TMP("SDWLI",$J) G EN1
     23 K DIR,DIC,DR,DIE,VADM
     24 S (SDWLBDT,SDWLEDT)="" K ^TMP("SDWLI",$J)
     25 ;
     26 ;OPTION HEADER
     27 ;
     28 D HD
     29 ;
     30 ;PATIENT LOOK-UP FROM WAIT LIST PATIENT FILE (^SDWL(409.3,IEN,0).
     31 ;
     32 D PAT Q:'$D(SDWLDFN)
     33 G END:SDWLDFN<0,END:SDWLDFN=""
     34 Q:$D(DUOUT)
     35EN1 K DIR,DIC,DR,DIE,SDWLDRG
     36 D SEL G EN:$D(DUOUT)
     37 D GETFILE
     38 D DISP G EN:'$D(DUOUT)
     39 D END
     40 Q
     41PAT ;PATIENT LOOK-UP
     42 S DIC(0)="EMNQA",DIC=409.3 D ^DIC S (SDWLDFN,DFN)=$P(Y,U,2)
     43 G PATEND:SDWLDFN=""
     44 Q:Y<0
     45 Q:$D(DUOUT)
     46 D 1^VADPT
     47PATEND Q
     48 ;
     49 ;PROMPT FOR DISPLAY 'OPEN' WAITING LIST ONLY OR PROMPT FOR BEGINNING AND ENDING DATES
     50 ;
     51SEL K SDWLDRG S DIR(0)="YAO^^" S DIR("A")="Do You Want to View Only 'OPEN' Wait Lists? Yes// "
     52 S DIR("?")="'Yes' for 'Open' and these Patient Record have not been dispositioned and 'No' for all Records."
     53 W ! D ^DIR S SDWLY=Y W !
     54 I X["^" S DUOUT=1
     55 I SDWLY=0 D SEL1
     56 Q
     57SEL1 K DIR,%DT(0) S SDWLDISC="",%DT="AE",%DT("A")="Start with Date Entered: " D ^%DT G SEL:Y<1 S SDWLBDT=Y
     58 S %DT(0)=SDWLBDT,%DT("A")="End with Date Entered: " D ^%DT G SEL1:Y<1 S SDWLEDT=Y,SDWLDRG="" K %DT(0),%DT("A")
     59 Q
     60 ;
     61GETFILE ;GET DATA - OPTIONAL DATE RANGE IF SDWLDBT AND SDWLEDT VALID DATE RANGE
     62 ;
     63 K ^TMP("SDWLI",$J),SDWLDISX S SDWLDA=0,SDWLCNT=0 F  S SDWLDA=$O(^SDWL(409.3,"B",SDWLDFN,SDWLDA)) Q:SDWLDA=""  D
     64 .S SDWLDATA=$G(^SDWL(409.3,SDWLDA,0)) I '$D(SDWLDRG),$P(SDWLDATA,U,17)["C" Q
     65 .I '$P(SDWLDATA,U,3) Q
     66 .N SDWLAPP S SDWLAPP="" I $D(^SDWL(409.3,SDWLDA,"SDAPT")) S SDWLAPP=^("SDAPT") D  ;app data
     67 ..S SDWLAPP=SDWLAPP_"~"_$P(SDWLDATA,U,23)
     68 .N SDOP,SDOP1 S SDOP="" I $D(^SDWL(409.3,SDWLDA,1)) S SDOP=^(1),SDOP1=$$GET1^DIQ(409.3,SDWLDA_",",29),$P(SDOP,U)=SDOP1
     69 .I $D(^SDWL(409.3,SDWLDA,"DIS")) D
     70 ..S SDWLDISX=$G(^SDWL(409.3,SDWLDA,"DIS")),SDWLDIS=$P(SDWLDISX,U,3),SDWLDDUZ=$P(SDWLDISX,U,2)
     71 ..S SDWLDDT=$P(^SDWL(409.3,SDWLDA,"DIS"),U,1)
     72 ..S SDWLDIDT="" I SDWLDDT'="" S SDWLDIDT=$E(SDWLDDT,4,5)_"/"_$E(SDWLDDT,6,7)_"/"_$E(SDWLDDT,2,3)
     73 .I $D(^SDWL(409.3,SDWLDA,"DNR")) D
     74 ..S SDREM=$G(^SDWL(409.3,SDWLDA,"DNR")) S SDREMD=$P(SDWLDATA,U,14),SDREMU=$P(SDWLDATA,U,15)
     75 ..S SDREMDD="" I SDREMD'="" S SDREMDD=$E(SDREMD,4,5)_"/"_$E(SDREMD,6,7)_"/"_$E(SDREMD,2,3)
     76 ..S SDREMR=$$GET1^DIQ(409.3,SDWLDA_",",18),SDREMRC=$$GET1^DIQ(409.3,SDWLDA_",",18.1,"I")
     77 .S SDWLST=$P(SDWLDATA,U,6),SDWLSP=$P(SDWLDATA,U,7),SDWLSS=$P(SDWLDATA,U,8),SDWLSC=$P(SDWLDATA,U,9),SDWLDT=$P(SDWLDATA,U,2)
     78 .S SDWLPROV=$P(SDWLDATA,U,13) I $D(SDWLDRG) D  I SDNOK Q
     79 ..S SDNOK=0
     80 ..I SDWLDT<SDWLBDT!(SDWLDT>SDWLEDT) S SDNOK=1 Q
     81 .;
     82 .;IF STATUS IS CLOSED DO NOT DISPLAY RECORD
     83 .;
     84 .S SDWLCNT=SDWLCNT+1,^TMP("SDWLI",$J,SDWLCNT)=SDWLDATA_"~"_SDWLDA
     85 .I $D(SDWLDISX) D
     86 ..S ^TMP("SDWLI",$J,SDWLCNT,"DIS")=SDWLDIS_"^"_SDWLDDUZ_"^"_SDWLDIDT
     87 ..I SDWLAPP>0 S ^TMP("SDWLI",$J,SDWLCNT,"SDAPT")=SDWLAPP
     88 ..I SDOP'="" S ^TMP("SDWLI",$J,SDWLCNT,"SDOP")=SDOP
     89 .I $D(SDREM) D
     90 ..S ^TMP("SDWLI",$J,SDWLCNT,"REM")=SDREMR_U_SDREMRC_U_SDREMU_U_SDREMDD
     91 .S ^TMP("SDWLI",$J)=SDWLCNT
     92 .K SDWLDISX,SDREM
     93 Q
     94 ;
     95DISP ;Display Wait List Data
     96 S (SDWLDT,SDWLCNT,SDWLCN)="",SDWLCT=$G(^TMP("SDWLI",$J)) I 'SDWLCT W !!,"No 'OPEN' Wait List Records to Display.",!! K DIR S DIR(0)="E" D ^DIR S DUOUT="" Q
     97 F  S SDWLCNT=$O(^TMP("SDWLI",$J,SDWLCNT)) Q:SDWLCNT=""  D  I $D(DUOUT) Q
     98 .N SDWLDISX,SDWLR,SDWLCLPT
     99 .I $D(^TMP("SDWLI",$J,SDWLCNT,"DIS")) S SDWLDISX=$G(^TMP("SDWLI",$J,SDWLCNT,"DIS"))
     100 .I $D(^TMP("SDWLI",$J,SDWLCNT,"REM")) S SDWLR=$G(^TMP("SDWLI",$J,SDWLCNT,"REM")) D
     101 ..S SDREMR=$P(SDWLR,U),SDREMRC=$P(SDWLR,U,2),SDREMU=$P(SDWLR,U,3),SDREMDD=$P(SDWLR,U,4)
     102 .S X=$G(^TMP("SDWLI",$J,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)
     103 .S SDWLTYP=$S(SDWLTY=1:$P(X,U,6),SDWLTY=2:$P(X,U,7),SDWLTY=3:$P(X,U,8),SDWLTY=4:$P(X,U,9),1:"")
     104 .S SDWLTYN=$S(SDWLTY=1:5,SDWLTY=2:6,SDWLTY=3:7,SDWLTY=4:8,1:0),SDWLCOM=$P($P(X,U,18),"~",1)
     105 .S SDWLDUZ=$P(X,U,10),SDWLPRV=$P(X,U,12),SDWLPROV=$P(X,U,13),SDWLX=$P(X,"~",3) D
     106 ..I $D(SDWLDISX) S SDWLDIS=$P(SDWLDISX,U,1),SDWLDDUZ=$P(SDWLDISX,U,2),SDWLDIDT=$P(SDWLDISX,U,3)
     107 .S SDWLDT=$P(X,U,2),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
     108 .S SDWLDTD=$P(X,U,16),YY=$E(SDWLDTD,1,3)+1700,YY=$E(YY,3,4),MM=$E(SDWLDTD,4,5),DD=$E(SDWLDTD,6,7),SDWLDTD=MM_"/"_DD_"/"_YY
     109 .;PATCH SD*5.3*394 See Note.
     110 .N SDWLSCP
     111 .S SDWLSCP=+$P($G(^SDWL(409.3,SDWLDA,"SC")),U,2)
     112 .W !,"# ",$J(SDWLCNT,3),!
     113 .W !,"Wait List - ",$$EXTERNAL^DILFD(409.3,4,,SDWLTY),?55,"Date Entered - ",SDWLDTP
     114 .W !,?15 S X=$$EXTERNAL^DILFD(409.3,SDWLTYN,,SDWLTYP) W X
     115 .S SDWLP=0 I SDWLPRI W !,"Priority - ",$$EXTERNAL^DILFD(409.3,10,,SDWLPRI) S SDWLP=1
     116 .I $D(SDWLSCP) W !,"Service Connected Priority - ",$$EXTERNAL^DILFD(409.3,15,,SDWLSCP)
     117 .W:SDWLP ?15 W:'SDWLP ! W "Institution - ",$$EXTERNAL^DILFD(409.3,2,,SDWLIN)
     118 .W !,"Entered by - " S X=$$EXTERNAL^DILFD(409.3,9,,SDWLDUZ) W X
     119 .S SDWRB=0 I SDWLPRV W !,"Requested By - ",$$EXTERNAL^DILFD(409.3,11,,SDWLPRV),?55,"Date Desired - ",SDWLDTD
     120 .I SDWLPRV=1 W !,"Provider - ",$$EXTERNAL^DILFD(409.3,12,,SDWLPROV)
     121 .I $D(SDWLCOM),SDWLCOM'="" W !,"Comments - ",SDWLCOM
     122 .I $D(^TMP("SDWLI",$J,SDWLCNT,"SDOP")) N SDOP S SDOP=^("SDOP") W !,"Reopen Reason: ",$P(SDOP,U) D
     123 ..I $P(SDOP,U,2)'="" W !,"Reopen comment: ",$P(SDOP,U,2)
     124 .I $D(^TMP("SDWLI",$J,SDWLCNT,"REM")) W !,"Non Removal Reason - ",SDREMR,!,"Non Remove Reason entered by - ",$$GET1^DIQ(200,SDREMU_",",.01,"I") D
     125 ..I $L(SDREMRC)>0 W !,"Non Removal Comment - ",SDREMRC
     126 ..W !,"Non Removal entry date - ",SDREMDD
     127 .I $D(^TMP("SDWLI",$J,SDWLCNT,"DIS")) W !,"Disposition - ",$$EXTERNAL^DILFD(409.3,21,,SDWLDIS),?51,"Disposition Date - ",SDWLDIDT D
     128 ..W !,"Dispositioned by - ",$$EXTERNAL^DILFD(409.3,20,,SDWLDDUZ)
     129 .I $D(^TMP("SDWLI",$J,SDWLCNT,"SDAPT")) N SDAP S SDAP=^("SDAPT") D
     130 ..W !,"Appointment scheduled for " S Y=$P(SDAP,"~",2) D DD^%DT W Y
     131 ..W !?3,"Made on: " S Y=+SDAP D DD^%DT W Y,?30,"For clinic: " N SDC S SDC=$P(SDAP,U,2) S SDC=$$GET1^DIQ(44,SDC_",",.01) W SDC
     132 ..N SDAIN S SDAIN=$P(SDAP,U,3),SDAIN=$$GET1^DIQ(4,SDAIN_",",.01)
     133 ..W !?3,"Appt Institution: ",SDAIN
     134 ..N SDCR S SDCR=$P(SDAP,U,4),SDCR=$$GET1^DIQ(40.7,SDCR_",",.01)
     135 ..W ?40,"Appt Specialty: ",SDCR
     136 ..N SAPS S SAPS=$P(SDAP,U,8),SAPS=$P(SAPS,"~") I SAPS="CC" W !,"Appointment Status: Canceled by Clinic"
     137 .S SDWLCLPT=$$GET1^DIQ(409.3,SDWLDA,37,"I")  ; SD*5.3*446
     138 .D:SDWLCLPT  ; SD*5.3*446
     139 ..W !,"Clinic changed from: ",$$GET1^DIQ(409.3,SDWLCLPT,8)
     140 ..W:SDWLIN'=$$GET1^DIQ(409.3,SDWLCLPT,2,"I") " (",$$GET1^DIQ(409.3,SDWLCLPT,2),")"
     141 ..Q
     142 .; Inter-facility Transfer. SD*5.3*446
     143 .I $$GETTRN^SDWLIFT1(SDWLDA,.SDWLINNM,.SDWLSTN) D ENS^%ZISS W !,IOINHI,"In transfer to ",SDWLINNM," (",SDWLSTN,")",IOINORM D KILL^%ZISS
     144 .D GETS^DIQ(409.3,SDWLDA,"32;33;34;36;38;39","TMP")
     145 .K SDWLIN,SDWLCL,SDWLTY,SDWLPRI,SDWLDUZ,SDWLPRV,SDWLDT,SDWLDTD,SDWLDIS,SDWLDIDT,SDWLTYN,SDWLCOM,SDWLPROV,SDWLDISX,DIR,DIE,DR,SDWLINNM,SDWLSTN
     146 .W !,"*****",! K DIR S DIR(0)="E" D ^DIR  D
     147 ..I X["^" S DUOUT=1 Q
     148 ..I 'Y S DUOUT=1 Q
     149 ..D HD
     150 Q
     151HD ;Header
     152 W:$D(IOF) @IOF W !!,?80-$L("Wait List - Inquiry")\2,"Wait List - Inquiry ",!
     153 ;SD*5.3*327 - Correct undefined.
     154 I '$D(SDWLDFN) W !! Q
     155 N DFN S DFN=SDWLDFN D DEM^VADPT
     156 W:$D(VADM) !,VADM(1),?40 I $D(VA("PID")) W VA("PID")
     157 W !!
     158 K DUOUT
     159 Q
     160END ;
     161 K DIR,DIC,DR,DIE,SDWLDFN,DUOUT
     162 K SDNOK,SDWLBDT,SDWLCL,SDWLCN,SDWLCNT,SDWLCOM,SDWLCT,SDWLDA,SDWLDATA,SDWLDDT,SDWLDDUZ,SDWLDFN,SDWLDIDT,SDWLDIS,SDWLDISX
     163 K SDWLDRG,SDWLDT,SDWLDTD,SDWLDTP,SDWLDUZ,SDLWEDT,SDWLIN,SDLWP,SDWLPRI,SDWLPROV,SDLWPRV,SDWLSC,SDWLSP,SDWLSS,SDLWST,SDWLTY
     164 K SDWLTYN,SDSWLTYP,SDLWX,SDWLY,SDWRB,SDWLBDT,SDWLDISC,SDWLERR,SDWLPRON,SDXSCAT,SDWLP,SDWLTYP
     165 Q
Note: See TracChangeset for help on using the changeset viewer.