source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMREV.m@ 1073

Last change on this file since 1073 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
RevLine 
[613]1PXRMREV ; SLC/PJH,PKR - Review Date routines. ;06/17/2005
2 ;;2.0;CLINICAL REMINDERS;**4**;Feb 04, 2005;Build 21
3 ;
4 ;Select the review date
5 ;----------------------
6DATE() ;
7 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
8 S DIR(0)="DA^"_DT_"::EFTX"
9 S DIR("A")="Enter Review Cutoff Date: "
10 S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D")
11 S DIR("?")="This must be today or a future date. For detailed help type ??"
12 S DIR("??")=U_"D HELP^PXRMREV(2)"
13 W !
14 D ^DIR
15 I $D(DIROUT)!$D(DIRUT) Q ""
16 I $D(DTOUT)!($D(DUOUT)) Q ""
17 Q Y
18 ;
19 ;Select file for review
20 ;----------------------
21FILE() N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
22 S DIR(0)="SO"_U_"C:Computed Finding;"
23 S DIR(0)=DIR(0)_"D:Reminder Dialog;"
24 S DIR(0)=DIR(0)_"L:Reminder Location List;"
25 S DIR(0)=DIR(0)_"R:Reminder Definition;"
26 S DIR(0)=DIR(0)_"S:Reminder Sponsor;"
27 S DIR(0)=DIR(0)_"T:Reminder Taxonomy;"
28 S DIR("A")="Select File to Review"
29 S DIR("?")="Select from the codes displayed. For detailed help type ??"
30 S DIR("??")=U_"D HELP^PXRMREV(1)"
31 D ^DIR
32 I $D(DIROUT)!$D(DIROUT) Q ""
33 I $D(DTOUT)!$D(DUOUT) Q ""
34 Q Y
35 ;
36 ;General help text routine
37 ;-------------------------
38HELP(CALL) ;
39 N DIWF,DIWL,DIWR,HTEXT,IC
40 S DIWF="C70",DIWL=0,DIWR=70
41 I CALL=1 D
42 .S HTEXT(1)="Select the file for which a Review Date report is required."
43 .S HTEXT(2)=" "
44 .S HTEXT(3)="The report lists in review date order all file entries which"
45 .S HTEXT(4)="have a review date prior to the cuttoff date."
46 I CALL=2 D
47 .S HTEXT(1)="Enter a future date or today. All review dates in the file"
48 .S HTEXT(2)="selected which are prior or equal to this date will be reported."
49 K ^UTILITY($J,"W")
50 S IC=""
51 F S IC=$O(HTEXT(IC)) Q:IC="" D
52 . S X=HTEXT(IC)
53 . D ^DIWP
54 W !
55 S IC=0
56 F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
57 . W !,^UTILITY($J,"W",0,IC,0)
58 K ^UTILITY($J,"W")
59 W !
60 Q
61 ;
62 ;Print review date reports
63 ;-------------------------
64START N DATE,DIROUT,DONE,DTOUT,DUOUT,FTYPE
65 S DONE=0
66 F Q:DONE D
67 . S FTYPE=$$FILE
68 . I FTYPE="" S DONE=1 Q
69 . S DATE=$$DATE
70 . I DATE="" S DONE=1 Q
71 .;
72 . N BY,DHD,DIC,FLDS,FR,L,NOW,TO
73 . S FR="01/01/2000"
74 . S TO=DATE
75 . S BY="REVIEW DATE"
76 . S FLDS=".01,REVIEW DATE;C60"
77 . S L=0
78 .;
79 . I FTYPE="C" S DIC="^PXRMD(811.4,",DHD="CF'S TO REVIEW"
80 . I FTYPE="D" S DIC="^PXRMD(801.41,",DHD="DIALOGS TO REVIEW"
81 . I FTYPE="L" S DIC="^PXRMD(810.9,",DHD="LOCATION LISTS TO REVIEW"
82 . I FTYPE="R" S DIC="^PXD(811.9,",DHD="REMINDERS TO REVIEW"
83 . I FTYPE="S" S DIC="^PXRMD(811.6,",DHD="SPONSORS TO REVIEW"
84 . I FTYPE="T" S DIC="^PXD(811.2,",DHD="TAXONOMIES TO REVIEW"
85 .;
86 . S DHD=DHD_" (up to "_$$FMTE^XLFDT(DATE)_")"
87 .;Print
88 . D EN1^DIP
89 Q
90 ;
Note: See TracBrowser for help on using the repository browser.