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/SCRPW63.m

    r613 r623  
    1 SCRPW63 ;BP-CIOFO/KEITH - SC veterans awaiting appointments (cont.) ; 23 August 2002@20:23
    2         ;;5.3;Scheduling;**267,269,357,491**;AUG 13, 1993;Build 53
    3         ;
    4 E       ;Gather data for patients entered report
    5         N DFN,SDX,SDATE,SD0,SDSCEL,SDEL,SDYR,SDREL,SDTOT,SDSDT,SDLVDT,SDEDT
    6         N SDNAME
    7         D SCEL^SCRPW62(.SDSCEL,SDSCVT)  ;Get eligibility code pointers
    8         S (SDSDT,SDATE)=DT-(10000*SDATES),SDSTOP=0
    9         ;Find the patients entered after date specified
    10         S DFN=0 F  Q:SDSTOP  S DFN=$O(^DPT(DFN)) Q:'DFN  D
    11         .Q:$D(^DPT(DFN,-9))  ;Skip merged records
    12         .I DFN#1000=0 D STOP Q:SDSTOP  ;Check for stop task request
    13         .S SDLVDT=""
    14         .S SD0=$G(^DPT(DFN,0)) Q:'$L(SD0)
    15         .S SDEDT=$P(SD0,U,16) S:SDEDT SDLVDT=SDEDT
    16         .I SDEDT,SDEDT<SDATE Q  ;Date entered < start date
    17         .I 'SDEDT,SDLVDT<SDATE Q  ;No date entered, last valid date < start
    18         .S SDEL=+$G(^DPT(DFN,.36)) Q:'$D(SDSCEL(SDEL))  ;Only SC vets
    19         .Q:+$G(^DPT(DFN,.35))  ;No deceased patients
    20         .Q:$$SCHAPP(DFN)  ;Appointments not cancelled by clinic?
    21         .S SDYR=$$FMDIFF^XLFDT(DT,$S(SDEDT:SDEDT,1:SDLVDT))\365.25  ;Year entered
    22         .S SDEL=SDSCEL(SDEL) D  Q:SDFMT="S"
    23         ..;Record statistics
    24         ..S ^TMP("SCRPW",$J,"STATS",SDYR,SDEL)=$G(^TMP("SCRPW",$J,"STATS",SDYR,SDEL))+1
    25         ..Q
    26         .S SDNAME=$P(SD0,U) Q:'$L(SDNAME)
    27         .S ^TMP("SCRPW",$J,SDEL,SDNAME,DFN)=SD0
    28         .Q
    29         Q:SDSTOP
    30         D:$E(IOST,1,2)="C-" DISP0^SCRPW23
    31         I '$D(^TMP("SCRPW",$J)) D  Q  ;Negative report
    32         .D HDR^SCRPW62 S SDX="No patients found within report parameters!"
    33         .W !!?(132-$L(SDX)\2),SDX
    34         .I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR
    35         .Q
    36         ;Detailed report
    37         I SDFMT="D" D HDR^SCRPW62 S SDEL=0 F  S SDEL=$O(^TMP("SCRPW",$J,SDEL)) Q:'SDEL!SDOUT  D
    38         .S SDNAME="" F  S SDNAME=$O(^TMP("SCRPW",$J,SDEL,SDNAME)) Q:SDNAME=""!SDOUT  S DFN=0 D
    39         ..F  S DFN=$O(^TMP("SCRPW",$J,SDEL,SDNAME,DFN)) Q:'DFN!SDOUT  D
    40         ...S SDREL=$S(SDEL=1:0,1:+$P($G(^DPT(DFN,.372,0)),U,4))
    41         ...D:$Y>(IOSL-(4+SDREL)) HDR^SCRPW62 Q:SDOUT
    42         ...S SDX=^TMP("SCRPW",$J,SDEL,SDNAME,DFN) D PLINE(DFN,SDX,SDEL)
    43         ...Q
    44         .Q
    45         Q:SDOUT
    46 ESUM    ;Print summary
    47         G:SDELIM EQ
    48         S SDT(3)="STATISTICAL SUMMARY" D HDR^SCRPW62 Q:SDOUT
    49         W !! S SDYR="",SDTOT=0
    50         F  S SDYR=$O(^TMP("SCRPW",$J,"STATS",SDYR)) Q:SDYR=""  D
    51         .S SDEL=0 F  S SDEL=$O(^TMP("SCRPW",$J,"STATS",SDYR,SDEL)) Q:'SDEL  D
    52         ..S SDX=$$CSCEL(SDEL)_" veterans entered "_$S(SDYR=0:"in the past year",SDYR=1:"two years ago",SDYR=2:"three years ago",1:"")_":"
    53         ..W !?36,$J(SDX,45),?83,$J(^TMP("SCRPW",$J,"STATS",SDYR,SDEL),6,0)
    54         ..S SDTOT=SDTOT+^TMP("SCRPW",$J,"STATS",SDYR,SDEL)
    55         ..Q
    56         .Q
    57         W !?36,$E(SDLINE,1,53),!?75,"TOTAL:",?83,$J(SDTOT,6,0)
    58 EQ      I $E(IOST,1,2)="C-" N DIR S DIR(0)="E" W !! D ^DIR
    59         Q
    60         ;
    61 SCHAPP(DFN)     ;Look for scheduled appointments not cancelled by clinic
    62         ; Input: DFN=patient ifn
    63         ;Output: '1' if appointments exist, '0' otherwise
    64         N SDI,SDX,SDY
    65         S (SDI,SDY)=0
    66         F  S SDI=$O(^DPT(DFN,"S",SDI)) Q:'SDI!SDY  D
    67         .S SDX=$G(^DPT(DFN,"S",SDI,0)) Q:'$L(SDX)
    68         .S SDX=$P(SDX,U,2) I $L(SDX),"CA"[SDX Q
    69         .S SDY=1
    70         .Q
    71         Q SDY
    72         ;
    73 A       ;Gather data for future appointments report
    74         N DFN,SDA0,SDX,SDI,SDSCEL,SDEL,SDDATE,SDIFF,SDAPT,SDIVL,SDIVN
    75         N SDREL,SDTOT,SDIV,SD0,SDNAME
    76         D SCEL^SCRPW62(.SDSCEL,SDSCVT)  ;Get eligibility code pointers
    77         S DFN=0 F  S DFN=$O(^DPT(DFN)) Q:'DFN!SDSTOP  D
    78         .I DFN#1000=0 D STOP Q:SDSTOP  ;Check for stop task request
    79         .S SDEL=+$G(^DPT(DFN,.36)) Q:'$D(SDSCEL(SDEL))  ;Only SC vets
    80         .S SDEL=SDSCEL(SDEL)
    81         .Q:+$G(^DPT(DFN,.35))  ;No deceased patients
    82         .S SDI=DT F  S SDI=$O(^DPT(DFN,"S",SDI)) Q:'SDI  D
    83         ..S SDDATE=+$G(^DPT(DFN,"S",SDI,1)) Q:'SDDATE  Q:SDDATE>SDI
    84         ..S SDA0=$G(^DPT(DFN,"S",SDI,0)) Q:'$L(SDA0)
    85         ..S SDIV=$P($G(^SC(+SDA0,0)),U,15) Q:'$$DIV(.SDIV)  ;Division check
    86         ..;Exclude cancelled appointments
    87         ..S SDX=$P(SDA0,U,2) I $L(SDX),"PCA"[SDX Q
    88         ..S SDIFF=$$FMDIFF^XLFDT(SDI,SDDATE) Q:SDIFF'>SDATES
    89         ..S SDNAME=$P($G(^DPT(DFN,0)),U) Q:'$L(SDNAME)
    90         ..;Record detailed information
    91         ..S ^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN,SDI)=SDDATE_U_SDA0
    92         ..S ^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN)=$G(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN))+1
    93         ..Q
    94         .Q
    95         Q:SDSTOP
    96         ;Tally up statistics
    97         S SDIV=0 F  S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:'SDIV  D
    98         .S SDEL=0 F  S SDEL=$O(^TMP("SCRPW",$J,SDIV,SDEL)) Q:'SDEL  D
    99         ..S SDNAME="" F  S SDNAME=$O(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME)) Q:SDNAME=""!SDOUT  D
    100         ...S DFN=0 F  S DFN=$O(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN)) Q:'DFN  D
    101         ....S ^TMP("SCRPW",$J,"STATS",SDIV,SDEL,"PTS")=$G(^TMP("SCRPW",$J,"STATS",SDIV,SDEL,"PTS"))+1
    102         ....S SDI=0 F  S SDI=$O(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN,SDI)) Q:'SDI  D
    103         .....S ^TMP("SCRPW",$J,"STATS",SDIV,SDEL,"APPTS")=$G(^TMP("SCRPW",$J,"STATS",SDIV,SDEL,"APPTS"))+1
    104         .....Q
    105         ....Q
    106         ...Q
    107         ..Q
    108         .Q
    109         Q:SDSTOP
    110         ;Print report
    111         S SDIV="" F  S SDIV=$O(SDDIV(SDIV)) Q:'SDIV  S SDIV(SDDIV(SDIV))=SDIV
    112         I 'SDDIV,$P(SDDIV,U,2)'="ALL DIVISIONS" D
    113         .S SDIV($P(SDDIV,U,2))=$$PRIM^VASITE()
    114         .Q
    115         I $P(SDDIV,U,2)="ALL DIVISIONS" S SDI=0 D
    116         .F  S SDI=$O(^TMP("SCRPW",$J,SDI)) Q:'SDI  D
    117         ..S SDX=$P($G(^DG(40.8,SDI,0)),U) S:$L(SDX) SDIV(SDX)=SDI
    118         ..Q
    119         .Q
    120         D:$E(IOST)="C" DISP0^SCRPW23
    121         I '$D(^TMP("SCRPW",$J)) D  Q  ;Negative report
    122         .S SDIV=0 D DHDR^SCRPW40(3,.SDT),HDR^SCRPW62
    123         .S SDX="No appointments found that meet report criteria."
    124         .I SDELIM W !,SDX Q
    125         .W !!?(IOM-$L(SDX)\2),SDX
    126         .I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR
    127         .Q
    128         G:SDFMT="S" ASUM
    129         ;Print detailed report by division
    130         S SDIVN="" F  S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN=""!SDOUT  D
    131         .S SDIV=SDIV(SDIVN) D ADPRT(.SDIV)
    132         .Q
    133         Q:SDOUT
    134         ;Print summary
    135 ASUM    G:SDELIM AQ
    136         S SDT(3)="STATISTICAL SUMMARY" D HDR^SCRPW62 Q:SDOUT
    137         W !! S (SDTOT,SDIV,SDIVL)=0,SDIVN=""
    138         F  S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN=""  D
    139         .S SDIVN(SDIV(SDIVN))=SDIVN S:$L(SDIVN)>SDIVL SDIVL=$L(SDIVN)
    140         F  S SDIV=$O(^TMP("SCRPW",$J,"STATS",SDIV)) Q:'SDIV  D
    141         .S SDEL=0 F  S SDEL=$O(^TMP("SCRPW",$J,"STATS",SDIV,SDEL)) Q:'SDEL  D
    142         ..S SDAPT=^TMP("SCRPW",$J,"STATS",SDIV,SDEL,"APPTS"),SDTOT=SDTOT+SDAPT
    143         ..S SDX=$$CSCEL(SDEL)_" appointments at "_SDIVN(SDIV)_":"
    144         ..W !?(50-SDIVL),$J(SDX,(28+SDIVL)),?80,$J(SDAPT,6,0)
    145         ..Q
    146         .Q
    147         W !?(50-SDIVL),$E(SDLINE,1,(36+SDIVL)),!?72,"TOTAL:",?80,$J(SDTOT,6,0)
    148 AQ      I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR
    149         Q
    150         ;
    151 DIV(SDIV)       ;Check division
    152         S:'$L(SDIV) SDIV=$$PRIM^VASITE()
    153         Q:'SDDIV 1  Q $D(SDDIV(+SDIV))
    154         ;
    155         ;
    156 STOP    ;Check for stop task request
    157         S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
    158         ;
    159 ADPRT(SDIV)     ;Print report for a division
    160         D DHDR^SCRPW40(3,.SDT) S:SDELIM SDPAGE=1
    161         I '$D(^TMP("SCRPW",$J,SDIV)) D HDR^SCRPW62 Q:SDOUT  D  Q
    162         .S SDX="No appointments found for this division within report parameters!"
    163         .I SDELIM W !,SDX Q
    164         .W !!?(132-$L(SDX)\2),SDX Q
    165         D HDR^SCRPW62 Q:SDOUT
    166         S SDEL="" F  S SDEL=$O(^TMP("SCRPW",$J,SDIV,SDEL)) Q:'SDEL!SDOUT  D
    167         .S SDNAME="" F  S SDNAME=$O(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME)) Q:SDNAME=""!SDOUT  D
    168         ..S DFN=0 F  S DFN=$O(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN)) Q:'DFN!SDOUT  D
    169         ...S SD0=$G(^DPT(DFN,0)) Q:'$L(SD0)
    170         ...S SDREL=$S(SDEL=1:0,1:+$P($G(^DPT(DFN,.372,0)),U,4))
    171         ...S SDREL=SDREL+^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN)
    172         ...D:$Y>(IOSL-(4+SDREL)) HDR^SCRPW62 Q:SDOUT
    173         ...D PLINE(DFN,SD0,SDEL)
    174         ...Q
    175         ..Q
    176         .Q
    177         Q
    178         ;
    179 PLINE(DFN,SD0,SDEL)     ;Print patient detail line         
    180         ;Input: DFN=patient ifn
    181         ;       SD0=zeroeth node of patient record
    182         ;      SDEL=1 or 3 to denote SC > or < 50%
    183         ;
    184         N SDSSN,SDNAME,SDDTE,SDADD,SDST,SDX,SDI,SDY,SDELN,SDZIP,SDZ,SDZA,SDII
    185         S SDNAME=$P(SD0,U),SDSSN=$P(SD0,U,9),SDDTE=$$FMTE^XLFDT($P(SD0,U,16))
    186         S SDSSN=$E(SDSSN,1,3)_"-"_$E(SDSSN,4,5)_"-"_$E(SDSSN,6,10)
    187         S SDEL=$G(SDEL),SDELN=$$CSCEL(SDEL),SDADD=$G(^DPT(DFN,.11))
    188         S SDST=$P($G(^DIC(5,+$P(SDADD,U,5),0)),U,2),SDZIP=$P(SDADD,U,12)
    189         S:$L(SDZIP)=9 SDZIP=$E(SDZIP,1,5)_"-"_$E(SDZIP,6,9)
    190         I SDELIM D  ;Set up delimited output
    191         .S SDZ=SDNAME_U_SDSSN_U_SDELN_U_SDDTE_U_$P(SDADD,U)_U_$P(SDADD,U,4)
    192         .S SDZ=SDZ_U_SDST_U_SDZIP_U_$P($G(^DPT(DFN,.13)),U)
    193         .Q
    194         I 'SDELIM D
    195         .;Print name, SSN, eligibility, date entered, address and phone number
    196         .W !,"Name: ",SDNAME,?39,"SSN: ",SDSSN,?58,"Prim. Elig.: ",SDELN
    197         .W ?84,"Date entered: ",SDDTE,!?10,"Address: ",$P(SDADD,U)
    198         .W ?55,$P(SDADD,U,4),$S($L($P(SDADD,U,4)):", ",1:""),SDST,"  ",SDZIP
    199         .W ?88,"Phone number: ",$P($G(^DPT(DFN,.13)),U)
    200         .;Print SC disabilities for 0-50% SC veterans
    201         .I SDEL=3 S SDI=0 F  S SDI=$O(^DPT(DFN,.372,SDI)) Q:'SDI  D
    202         ..S SDX=$G(^DPT(DFN,.372,SDI,0)) Q:'$P(SDX,U,3)
    203         ..S SDY=$G(^DIC(31,+SDX,0)) Q:'$L(SDY)
    204         ..W !?20,"SC disability: ",$P(SDY,U,3),"  ",$P(SDY,U)
    205         ..W ?89,"%SC: ",$P(SDX,U,2)
    206         ..Q
    207         .Q
    208         I SDRPT="E" D  Q
    209         .I SDELIM S SDZ(1)=SDZ D DELIM^SCRPW62(.SDZ) Q  ;W !,SDZ Q
    210         .W !
    211         .Q
    212         ;Print appointment details for future appointment report
    213         S SDI=0 D
    214         .F  S SDI=$O(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN,SDI)) Q:'SDI  D
    215         ..S SDA0=^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN,SDI)
    216         ..I 'SDELIM D
    217         ...W !?30,"Appointment: ",$$FMTE^XLFDT(SDI)
    218         ...W ?63,$P($G(^SC(+$P(SDA0,U,2),0)),U),?96,"Desired date: "
    219         ...W $$FMTE^XLFDT(+SDA0),?124,"(",$$FMDIFF^XLFDT(SDI,+SDA0),")"
    220         ...Q
    221         ..I SDELIM D  ;Delimited output
    222         ...N SDC0,SDCP,SDCZ,SDADM,SDADME
    223         ...S SDC0=$G(^SC(+$P(SDA0,U,2),0)),SDCZ=$$CPAIR^SCRPW71(SDC0,.SDCP)
    224         ...S SDII=0,(SDZA,SDADM,SDADME)=""
    225         ...F  S SDII=$O(^SC(+$P(SDA0,U,2),"S",SDI,1,SDII)) D  Q:'SDII
    226         ....Q:+$G(^SC(+$P(SDA0,U,2),"S",SDI,1,+SDII,0))'=DFN
    227         ....S SDADM=$P(^SC(+$P(SDA0,U,2),"S",SDI,1,+SDII,0),U,7)
    228         ....S SDADME=$$FMTE^XLFDT(SDADM),SDII=0
    229         ....Q
    230         ...S SDCZ=SDCP_U_$P($$SITE^VASITE(,$P(SDC0,U,15)),U,2)_U_SDADME
    231         ...S SDZA=SDZA_U_$$FMTE^XLFDT(SDI)_U_$P(SDC0,U)_U_SDCZ
    232         ...S SDZA=SDZA_U_$$FMTE^XLFDT(+SDA0)_U_$$FMDIFF^XLFDT(SDI,+SDA0)
    233         ...S SDZA=SDZA_U_$S(SDADM:$$FMDIFF^XLFDT(+SDA0,SDADM),1:"")
    234         ...S SDZ(1)=SDZ_SDZA
    235         ...D DELIM^SCRPW62(.SDZ)  ;W !,SDZ,SDZA
    236         ...Q
    237         ..Q
    238         .Q
    239         W:'SDELIM ! Q
    240         ;
    241 CSCEL(SDEL)     ;Convert SC elig. to external
    242         Q $S(SDEL=1:"SC 50-100%",SDEL=3:"SC < 50%",1:"")
     1SCRPW63 ;BP-CIOFO/KEITH - SC veterans awaiting appointments (cont.) ; 23 August 2002@20:23
     2 ;;5.3;Scheduling;**267,269,357**;AUG 13, 1993
     3 ;
     4E ;Gather data for patients entered report
     5 N DFN,SDX,SDATE,SD0,SDSCEL,SDEL,SDYR,SDREL,SDTOT,SDSDT,SDLVDT,SDEDT
     6 N SDNAME
     7 D SCEL^SCRPW62(.SDSCEL,SDSCVT)  ;Get eligibility code pointers
     8 S (SDSDT,SDATE)=DT-(10000*SDATES),SDSTOP=0
     9 ;Find the patients entered after date specified
     10 S DFN=0 F  Q:SDSTOP  S DFN=$O(^DPT(DFN)) Q:'DFN  D
     11 .Q:$D(^DPT(DFN,-9))  ;Skip merged records
     12 .I DFN#1000=0 D STOP Q:SDSTOP  ;Check for stop task request
     13 .S SDLVDT=""
     14 .S SD0=$G(^DPT(DFN,0)) Q:'$L(SD0)
     15 .S SDEDT=$P(SD0,U,16) S:SDEDT SDLVDT=SDEDT
     16 .I SDEDT,SDEDT<SDATE Q  ;Date entered < start date
     17 .I 'SDEDT,SDLVDT<SDATE Q  ;No date entered, last valid date < start
     18 .S SDEL=+$G(^DPT(DFN,.36)) Q:'$D(SDSCEL(SDEL))  ;Only SC vets
     19 .Q:+$G(^DPT(DFN,.35))  ;No deceased patients
     20 .Q:$$SCHAPP(DFN)  ;Appointments not cancelled by clinic?
     21 .S SDYR=$$FMDIFF^XLFDT(DT,$S(SDEDT:SDEDT,1:SDLVDT))\365.25  ;Year entered
     22 .S SDEL=SDSCEL(SDEL) D  Q:SDFMT="S"
     23 ..;Record statistics
     24 ..S ^TMP("SCRPW",$J,"STATS",SDYR,SDEL)=$G(^TMP("SCRPW",$J,"STATS",SDYR,SDEL))+1
     25 ..Q
     26 .S SDNAME=$P(SD0,U) Q:'$L(SDNAME)
     27 .S ^TMP("SCRPW",$J,SDEL,SDNAME,DFN)=SD0
     28 .Q
     29 Q:SDSTOP
     30 D:$E(IOST,1,2)="C-" DISP0^SCRPW23
     31 I '$D(^TMP("SCRPW",$J)) D  Q  ;Negative report
     32 .D HDR^SCRPW62 S SDX="No patients found within report parameters!"
     33 .W !!?(132-$L(SDX)\2),SDX
     34 .I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR
     35 .Q
     36 ;Detailed report
     37 I SDFMT="D" D HDR^SCRPW62 S SDEL=0 F  S SDEL=$O(^TMP("SCRPW",$J,SDEL)) Q:'SDEL!SDOUT  D
     38 .S SDNAME="" F  S SDNAME=$O(^TMP("SCRPW",$J,SDEL,SDNAME)) Q:SDNAME=""!SDOUT  S DFN=0 D
     39 ..F  S DFN=$O(^TMP("SCRPW",$J,SDEL,SDNAME,DFN)) Q:'DFN!SDOUT  D
     40 ...S SDREL=$S(SDEL=1:0,1:+$P($G(^DPT(DFN,.372,0)),U,4))
     41 ...D:$Y>(IOSL-(4+SDREL)) HDR^SCRPW62 Q:SDOUT
     42 ...S SDX=^TMP("SCRPW",$J,SDEL,SDNAME,DFN) D PLINE(DFN,SDX,SDEL)
     43 ...Q
     44 .Q
     45 Q:SDOUT
     46ESUM ;Print summary
     47 G:SDELIM EQ
     48 S SDT(3)="STATISTICAL SUMMARY" D HDR^SCRPW62 Q:SDOUT
     49 W !! S SDYR="",SDTOT=0
     50 F  S SDYR=$O(^TMP("SCRPW",$J,"STATS",SDYR)) Q:SDYR=""  D
     51 .S SDEL=0 F  S SDEL=$O(^TMP("SCRPW",$J,"STATS",SDYR,SDEL)) Q:'SDEL  D
     52 ..S SDX=$$CSCEL(SDEL)_" veterans entered "_$S(SDYR=0:"in the past year",SDYR=1:"two years ago",SDYR=2:"three years ago",1:"")_":"
     53 ..W !?36,$J(SDX,45),?83,$J(^TMP("SCRPW",$J,"STATS",SDYR,SDEL),6,0)
     54 ..S SDTOT=SDTOT+^TMP("SCRPW",$J,"STATS",SDYR,SDEL)
     55 ..Q
     56 .Q
     57 W !?36,$E(SDLINE,1,53),!?75,"TOTAL:",?83,$J(SDTOT,6,0)
     58EQ I $E(IOST,1,2)="C-" N DIR S DIR(0)="E" W !! D ^DIR
     59 Q
     60 ;
     61SCHAPP(DFN) ;Look for scheduled appointments not cancelled by clinic
     62 ; Input: DFN=patient ifn
     63 ;Output: '1' if appointments exist, '0' otherwise
     64 N SDI,SDX,SDY
     65 S (SDI,SDY)=0
     66 F  S SDI=$O(^DPT(DFN,"S",SDI)) Q:'SDI!SDY  D
     67 .S SDX=$G(^DPT(DFN,"S",SDI,0)) Q:'$L(SDX)
     68 .S SDX=$P(SDX,U,2) I $L(SDX),"CA"[SDX Q
     69 .S SDY=1
     70 .Q
     71 Q SDY
     72 ;
     73A ;Gather data for future appointments report
     74 N DFN,SDA0,SDX,SDI,SDSCEL,SDEL,SDDATE,SDIFF,SDAPT,SDIVL,SDIVN
     75 N SDREL,SDTOT,SDIV,SD0,SDNAME
     76 D SCEL^SCRPW62(.SDSCEL,SDSCVT)  ;Get eligibility code pointers
     77 S DFN=0 F  S DFN=$O(^DPT(DFN)) Q:'DFN!SDSTOP  D
     78 .I DFN#1000=0 D STOP Q:SDSTOP  ;Check for stop task request
     79 .S SDEL=+$G(^DPT(DFN,.36)) Q:'$D(SDSCEL(SDEL))  ;Only SC vets
     80 .S SDEL=SDSCEL(SDEL)
     81 .Q:+$G(^DPT(DFN,.35))  ;No deceased patients
     82 .S SDI=DT F  S SDI=$O(^DPT(DFN,"S",SDI)) Q:'SDI  D
     83 ..S SDDATE=+$G(^DPT(DFN,"S",SDI,1)) Q:'SDDATE  Q:SDDATE>SDI
     84 ..S SDA0=$G(^DPT(DFN,"S",SDI,0)) Q:'$L(SDA0)
     85 ..S SDIV=$P($G(^SC(+SDA0,0)),U,15) Q:'$$DIV(.SDIV)  ;Division check
     86 ..;Exclude cancelled appointments
     87 ..S SDX=$P(SDA0,U,2) I $L(SDX),"PCA"[SDX Q
     88 ..S SDIFF=$$FMDIFF^XLFDT(SDI,SDDATE) Q:SDIFF'>SDATES
     89 ..S SDNAME=$P($G(^DPT(DFN,0)),U) Q:'$L(SDNAME)
     90 ..;Record detailed information
     91 ..S ^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN,SDI)=SDDATE_U_SDA0
     92 ..S ^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN)=$G(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN))+1
     93 ..Q
     94 .Q
     95 Q:SDSTOP
     96 ;Tally up statistics
     97 S SDIV=0 F  S SDIV=$O(^TMP("SCRPW",$J,SDIV)) Q:'SDIV  D
     98 .S SDEL=0 F  S SDEL=$O(^TMP("SCRPW",$J,SDIV,SDEL)) Q:'SDEL  D
     99 ..S SDNAME="" F  S SDNAME=$O(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME)) Q:SDNAME=""!SDOUT  D
     100 ...S DFN=0 F  S DFN=$O(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN)) Q:'DFN  D
     101 ....S ^TMP("SCRPW",$J,"STATS",SDIV,SDEL,"PTS")=$G(^TMP("SCRPW",$J,"STATS",SDIV,SDEL,"PTS"))+1
     102 ....S SDI=0 F  S SDI=$O(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN,SDI)) Q:'SDI  D
     103 .....S ^TMP("SCRPW",$J,"STATS",SDIV,SDEL,"APPTS")=$G(^TMP("SCRPW",$J,"STATS",SDIV,SDEL,"APPTS"))+1
     104 .....Q
     105 ....Q
     106 ...Q
     107 ..Q
     108 .Q
     109 Q:SDSTOP
     110 ;Print report
     111 S SDIV="" F  S SDIV=$O(SDDIV(SDIV)) Q:'SDIV  S SDIV(SDDIV(SDIV))=SDIV
     112 I 'SDDIV,$P(SDDIV,U,2)'="ALL DIVISIONS" D
     113 .S SDIV($P(SDDIV,U,2))=$$PRIM^VASITE()
     114 .Q
     115 I $P(SDDIV,U,2)="ALL DIVISIONS" S SDI=0 D
     116 .F  S SDI=$O(^TMP("SCRPW",$J,SDI)) Q:'SDI  D
     117 ..S SDX=$P($G(^DG(40.8,SDI,0)),U) S:$L(SDX) SDIV(SDX)=SDI
     118 ..Q
     119 .Q
     120 D:$E(IOST)="C" DISP0^SCRPW23
     121 I '$D(^TMP("SCRPW",$J)) D  Q  ;Negative report
     122 .S SDIV=0 D DHDR^SCRPW40(3,.SDT),HDR^SCRPW62
     123 .S SDX="No appointments found that meet report criteria."
     124 .I SDELIM W !,SDX Q
     125 .W !!?(IOM-$L(SDX)\2),SDX
     126 .I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR
     127 .Q
     128 G:SDFMT="S" ASUM
     129 ;Print detailed report by division
     130 S SDIVN="" F  S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN=""!SDOUT  D
     131 .S SDIV=SDIV(SDIVN) D ADPRT(.SDIV)
     132 .Q
     133 Q:SDOUT
     134 ;Print summary
     135ASUM G:SDELIM AQ
     136 S SDT(3)="STATISTICAL SUMMARY" D HDR^SCRPW62 Q:SDOUT
     137 W !! S (SDTOT,SDIV,SDIVL)=0,SDIVN=""
     138 F  S SDIVN=$O(SDIV(SDIVN)) Q:SDIVN=""  D
     139 .S SDIVN(SDIV(SDIVN))=SDIVN S:$L(SDIVN)>SDIVL SDIVL=$L(SDIVN)
     140 F  S SDIV=$O(^TMP("SCRPW",$J,"STATS",SDIV)) Q:'SDIV  D
     141 .S SDEL=0 F  S SDEL=$O(^TMP("SCRPW",$J,"STATS",SDIV,SDEL)) Q:'SDEL  D
     142 ..S SDAPT=^TMP("SCRPW",$J,"STATS",SDIV,SDEL,"APPTS"),SDTOT=SDTOT+SDAPT
     143 ..S SDX=$$CSCEL(SDEL)_" appointments at "_SDIVN(SDIV)_":"
     144 ..W !?(50-SDIVL),$J(SDX,(28+SDIVL)),?80,$J(SDAPT,6,0)
     145 ..Q
     146 .Q
     147 W !?(50-SDIVL),$E(SDLINE,1,(36+SDIVL)),!?72,"TOTAL:",?80,$J(SDTOT,6,0)
     148AQ I $E(IOST)="C",'SDOUT N DIR S DIR(0)="E" D ^DIR
     149 Q
     150 ;
     151DIV(SDIV) ;Check division
     152 S:'$L(SDIV) SDIV=$$PRIM^VASITE()
     153 Q:'SDDIV 1  Q $D(SDDIV(+SDIV))
     154 ;
     155 ;
     156STOP ;Check for stop task request
     157 S:$G(ZTQUEUED) (SDOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0) Q
     158 ;
     159ADPRT(SDIV) ;Print report for a division
     160 D DHDR^SCRPW40(3,.SDT) S:SDELIM SDPAGE=1
     161 I '$D(^TMP("SCRPW",$J,SDIV)) D HDR^SCRPW62 Q:SDOUT  D  Q
     162 .S SDX="No appointments found for this division within report parameters!"
     163 .I SDELIM W !,SDX Q
     164 .W !!?(132-$L(SDX)\2),SDX Q
     165 D HDR^SCRPW62 Q:SDOUT
     166 S SDEL="" F  S SDEL=$O(^TMP("SCRPW",$J,SDIV,SDEL)) Q:'SDEL!SDOUT  D
     167 .S SDNAME="" F  S SDNAME=$O(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME)) Q:SDNAME=""!SDOUT  D
     168 ..S DFN=0 F  S DFN=$O(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN)) Q:'DFN!SDOUT  D
     169 ...S SD0=$G(^DPT(DFN,0)) Q:'$L(SD0)
     170 ...S SDREL=$S(SDEL=1:0,1:+$P($G(^DPT(DFN,.372,0)),U,4))
     171 ...S SDREL=SDREL+^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN)
     172 ...D:$Y>(IOSL-(4+SDREL)) HDR^SCRPW62 Q:SDOUT
     173 ...D PLINE(DFN,SD0,SDEL)
     174 ...Q
     175 ..Q
     176 .Q
     177 Q
     178 ;
     179PLINE(DFN,SD0,SDEL) ;Print patient detail line         
     180 ;Input: DFN=patient ifn
     181 ;       SD0=zeroeth node of patient record
     182 ;      SDEL=1 or 3 to denote SC > or < 50%
     183 ;
     184 N SDSSN,SDNAME,SDDTE,SDADD,SDST,SDX,SDI,SDY,SDELN,SDZIP,SDZ,SDZA,SDII
     185 S SDNAME=$P(SD0,U),SDSSN=$P(SD0,U,9),SDDTE=$$FMTE^XLFDT($P(SD0,U,16))
     186 S SDSSN=$E(SDSSN,1,3)_"-"_$E(SDSSN,4,5)_"-"_$E(SDSSN,6,10)
     187 S SDEL=$G(SDEL),SDELN=$$CSCEL(SDEL),SDADD=$G(^DPT(DFN,.11))
     188 S SDST=$P($G(^DIC(5,+$P(SDADD,U,5),0)),U,2),SDZIP=$P(SDADD,U,12)
     189 S:$L(SDZIP)=9 SDZIP=$E(SDZIP,1,5)_"-"_$E(SDZIP,6,9)
     190 I SDELIM D  ;Set up delimited output
     191 .S SDZ=SDNAME_U_SDSSN_U_SDELN_U_SDDTE_U_$P(SDADD,U)_U_$P(SDADD,U,4)
     192 .S SDZ=SDZ_U_SDST_U_SDZIP_U_$P($G(^DPT(DFN,.13)),U)
     193 .Q
     194 I 'SDELIM D
     195 .;Print name, SSN, eligibility, date entered, address and phone number
     196 .W !,"Name: ",SDNAME,?39,"SSN: ",SDSSN,?58,"Prim. Elig.: ",SDELN
     197 .W ?84,"Date entered: ",SDDTE,!?10,"Address: ",$P(SDADD,U)
     198 .W ?55,$P(SDADD,U,4),$S($L($P(SDADD,U,4)):", ",1:""),SDST,"  ",SDZIP
     199 .W ?88,"Phone number: ",$P($G(^DPT(DFN,.13)),U)
     200 .;Print SC disabilities for 0-50% SC veterans
     201 .I SDEL=3 S SDI=0 F  S SDI=$O(^DPT(DFN,.372,SDI)) Q:'SDI  D
     202 ..S SDX=$G(^DPT(DFN,.372,SDI,0)) Q:'$P(SDX,U,3)
     203 ..S SDY=$G(^DIC(31,+SDX,0)) Q:'$L(SDY)
     204 ..W !?20,"SC disability: ",$P(SDY,U,3),"  ",$P(SDY,U)
     205 ..W ?89,"%SC: ",$P(SDX,U,2)
     206 ..Q
     207 .Q
     208 I SDRPT="E" D  Q
     209 .I SDELIM W !,SDZ Q
     210 .W !
     211 .Q
     212 ;Print appointment details for future appointment report
     213 S SDI=0 D
     214 .F  S SDI=$O(^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN,SDI)) Q:'SDI  D
     215 ..S SDA0=^TMP("SCRPW",$J,SDIV,SDEL,SDNAME,DFN,SDI)
     216 ..I 'SDELIM D
     217 ...W !?30,"Appointment: ",$$FMTE^XLFDT(SDI)
     218 ...W ?63,$P($G(^SC(+$P(SDA0,U,2),0)),U),?96,"Desired date: "
     219 ...W $$FMTE^XLFDT(+SDA0),?124,"(",$$FMDIFF^XLFDT(SDI,+SDA0),")"
     220 ...Q
     221 ..I SDELIM D  ;Delimited output
     222 ...N SDC0,SDCP,SDCZ,SDADM,SDADME
     223 ...S SDC0=$G(^SC(+$P(SDA0,U,2),0)),SDCZ=$$CPAIR^SCRPW71(SDC0,.SDCP)
     224 ...S SDII=0,(SDZA,SDADM,SDADME)=""
     225 ...F  S SDII=$O(^SC(+$P(SDA0,U,2),"S",SDI,1,SDII)) D  Q:'SDII
     226 ....Q:+$G(^SC(+$P(SDA0,U,2),"S",SDI,1,+SDII,0))'=DFN
     227 ....S SDADM=$P(^SC(+$P(SDA0,U,2),"S",SDI,1,+SDII,0),U,7)
     228 ....S SDADME=$$FMTE^XLFDT(SDADM),SDII=0
     229 ....Q
     230 ...S SDCZ=SDCP_U_$P($$SITE^VASITE(,$P(SDC0,U,15)),U,2)_U_SDADME
     231 ...S SDZA=SDZA_U_$$FMTE^XLFDT(SDI)_U_$P(SDC0,U)_U_SDCZ
     232 ...S SDZA=SDZA_U_$$FMTE^XLFDT(+SDA0)_U_$$FMDIFF^XLFDT(SDI,+SDA0)
     233 ...S SDZA=SDZA_U_$S(SDADM:$$FMDIFF^XLFDT(+SDA0,SDADM),1:"")
     234 ...W !,SDZ,SDZA
     235 ...Q
     236 ..Q
     237 .Q
     238 W:'SDELIM ! Q
     239 ;
     240CSCEL(SDEL) ;Convert SC elig. to external
     241 Q $S(SDEL=1:"SC 50-100%",SDEL=3:"SC < 50%",1:"")
Note: See TracChangeset for help on using the changeset viewer.