| 1 | PXRMREV ; 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 | ;----------------------
|
|---|
| 6 | DATE() ;
|
|---|
| 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 | ;----------------------
|
|---|
| 21 | FILE() 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 | ;-------------------------
|
|---|
| 38 | HELP(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 | ;-------------------------
|
|---|
| 64 | START 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 | ;
|
|---|
