Routine: PXRMREV

PXRMREV ; SLC/PJH,PKR - Review Date routines. ;01/27/2012

 ;;2.0;CLINICAL REMINDERS;**4,16,22**;Feb 04, 2005;Build 160

 ;Select the review date

 ;----------------------

DATE() ;

 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 S DIR(0)="DA^"_DT_"::EFTX"

 S DIR("A")="Enter Review Cutoff Date: "

 S DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D")

 S DIR("?")="This must be today or a future date. For detailed help type ??"

 S DIR("??")=U_"D HELP^PXRMREV(2)"

W !

 D ^DIR

 I $D(DIROUT)!$D(DIRUT) Q ""

 I $D(DTOUT)!($D(DUOUT)) Q ""

Q Y

 ;Select file for review

 ;----------------------

FILE() N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 S DIR(0)="SO"_U_"C:Computed Finding;"

 S DIR(0)=DIR(0)_"D:Reminder Dialog;"

 S DIR(0)=DIR(0)_"L:Reminder Location List;"

 S DIR(0)=DIR(0)_"O:Reminder Orderable Item Groups;"

 S DIR(0)=DIR(0)_"U:Reminder Order Check Rules;"

 S DIR(0)=DIR(0)_"R:Reminder Definition;"

 S DIR(0)=DIR(0)_"S:Reminder Sponsor;"

 S DIR(0)=DIR(0)_"T:Reminder Term;"

 S DIR(0)=DIR(0)_"X:Reminder Taxonomy;"

 S DIR("A")="Select File to Review"

 S DIR("?")="Select from the codes displayed. For detailed help type ??"

 S DIR("??")=U_"D HELP^PXRMREV(1)"

 D ^DIR

 I $D(DIROUT)!$D(DIROUT) Q ""

 I $D(DTOUT)!$D(DUOUT) Q ""

Q Y

 ;General help text routine

 ;-------------------------

HELP(CALL) ;

 N DIWF,DIWL,DIWR,HTEXT,IC

 S DIWF="C70",DIWL=0,DIWR=70

 I CALL=1 D

 .S HTEXT(1)="Select the file for which a Review Date report is required."

 .S HTEXT(2)=" "

 .S HTEXT(3)="The report lists in review date order all file entries which"

 .S HTEXT(4)="have a review date prior to the cuttoff date."

 I CALL=2 D

 .S HTEXT(1)="Enter a future date or today. All review dates in the file"

 .S HTEXT(2)="selected which are prior or equal to this date will be reported."

 K ^UTILITY($J,"W")

 S IC=""

 F  S IC=$O(HTEXT(IC)) Q:IC=""  D

 . S X=HTEXT(IC)

 . D ^DIWP

W !

 S IC=0

 F  S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC=""  D

 . W !,^UTILITY($J,"W",0,IC,0)

 K ^UTILITY($J,"W")

W !

 ;Print review date reports

 ;-------------------------

START N DATE,DIROUT,DONE,DTOUT,DUOUT,FTYPE

 S DONE=0

 F  Q:DONE  D

 . S FTYPE=$$FILE

 . I FTYPE="" S DONE=1 Q

 . S DATE=$$DATE

 . I DATE="" S DONE=1 Q

.;

 . N BY,DHD,DIC,FLDS,FR,L,NOW,TO

 . S FR="01/01/2000"

 . S TO=DATE

 . S BY="REVIEW DATE"

 . S FLDS=".01,REVIEW DATE;C60"

 . S L=0

.;

 . I FTYPE="C" S DIC="^PXRMD(811.4,",DHD="CF'S TO REVIEW"

 . I FTYPE="D" S DIC="^PXRMD(801.41,",DHD="DIALOGS TO REVIEW"

 . I FTYPE="L" S DIC="^PXRMD(810.9,",DHD="LOCATION LISTS TO REVIEW"

 . I FTYPE="R" S DIC="^PXD(811.9,",DHD="REMINDERS TO REVIEW"

 . I FTYPE="S" S DIC="^PXRMD(811.6,",DHD="SPONSORS TO REVIEW"

 . I FTYPE="X" S DIC="^PXD(811.2,",DHD="TAXONOMIES TO REVIEW"

 . I FTYPE="O" S DIC="^PXD(801,",DHD="ORDERABLE ITEM GROUPS TO REVIEW"

 . I FTYPE="U" S DIC="^PXD(801.1,",DHD="ORDER CHECK RULES TO REVIEW"

 . I FTYPE="T" S DIC="^PXRMD(811.5,",DHD="TERMS TO REVIEW"

.;

 . S DHD=DHD_" (up to "_$$FMTE^XLFDT(DATE)_")"

 .;Print

 . D EN1^DIP

PXRMREV   ; SLC/PJH,PKR - Review Date routines. ;01/27/2012

 +1       ;;2.0;CLINICAL REMINDERS;**4,16,22**;Feb 04, 2005;Build 160

 +2       ;

 +3       ;Select the review date

 +4       ;----------------------

DATE()    ;

 +1        NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 +2        SET DIR(0)="DA^"_DT_"::EFTX"

 +3        SET DIR("A")="Enter Review Cutoff Date: "

 +4        SET DIR("B")=$$FMTE^XLFDT($$DT^XLFDT,"D")

 +5        SET DIR("?")="This must be today or a future date. For detailed help type ??"

 +6        SET DIR("??")=U_"D HELP^PXRMREV(2)"

 +7        WRITE !

 +8        DO ^DIR

 +9        IF $DATA(DIROUT)!$DATA(DIRUT)

               QUIT ""

 +10       IF $DATA(DTOUT)!($DATA(DUOUT))

               QUIT ""

 +11       QUIT Y

 +12      ;

 +13      ;Select file for review

 +14      ;----------------------

FILE()     NEW DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y

 +1        SET DIR(0)="SO"_U_"C:Computed Finding;"

 +2        SET DIR(0)=DIR(0)_"D:Reminder Dialog;"

 +3        SET DIR(0)=DIR(0)_"L:Reminder Location List;"

 +4        SET DIR(0)=DIR(0)_"O:Reminder Orderable Item Groups;"

 +5        SET DIR(0)=DIR(0)_"U:Reminder Order Check Rules;"

 +6        SET DIR(0)=DIR(0)_"R:Reminder Definition;"

 +7        SET DIR(0)=DIR(0)_"S:Reminder Sponsor;"

 +8        SET DIR(0)=DIR(0)_"T:Reminder Term;"

 +9        SET DIR(0)=DIR(0)_"X:Reminder Taxonomy;"

 +10       SET DIR("A")="Select File to Review"

 +11       SET DIR("?")="Select from the codes displayed. For detailed help type ??"

 +12       SET DIR("??")=U_"D HELP^PXRMREV(1)"

 +13       DO ^DIR

 +14       IF $DATA(DIROUT)!$DATA(DIROUT)

               QUIT ""

 +15       IF $DATA(DTOUT)!$DATA(DUOUT)

               QUIT ""

 +16       QUIT Y

 +17      ;

 +18      ;General help text routine

 +19      ;-------------------------

HELP(CALL) ;

 +1        NEW DIWF,DIWL,DIWR,HTEXT,IC

 +2        SET DIWF="C70"

           SET DIWL=0

           SET DIWR=70

 +3        IF CALL=1

               Begin DoDot:1

 +4                SET HTEXT(1)="Select the file for which a Review Date report is required."

 +5                SET HTEXT(2)=" "

 +6                SET HTEXT(3)="The report lists in review date order all file entries which"

 +7                SET HTEXT(4)="have a review date prior to the cuttoff date."

               End DoDot:1

 +8        IF CALL=2

               Begin DoDot:1

 +9                SET HTEXT(1)="Enter a future date or today. All review dates in the file"

 +10               SET HTEXT(2)="selected which are prior or equal to this date will be reported."

               End DoDot:1

 +11       KILL ^UTILITY($JOB,"W")

 +12       SET IC=""

 +13       FOR

               SET IC=$ORDER(HTEXT(IC))

               IF IC=""

                   QUIT

               Begin DoDot:1

 +14               SET X=HTEXT(IC)

 +15               DO ^DIWP

               End DoDot:1

 +16       WRITE !

 +17       SET IC=0

 +18       FOR

               SET IC=$ORDER(^UTILITY($JOB,"W",0,IC))

               IF IC=""

                   QUIT

               Begin DoDot:1

 +19               WRITE !,^UTILITY($JOB,"W",0,IC,0)

               End DoDot:1

 +20       KILL ^UTILITY($JOB,"W")

 +21       WRITE !

 +22       QUIT

 +23      ;

 +24      ;Print review date reports

 +25      ;-------------------------

START      NEW DATE,DIROUT,DONE,DTOUT,DUOUT,FTYPE

 +1        SET DONE=0

 +2        FOR

               IF DONE

                   QUIT

               Begin DoDot:1

 +3                SET FTYPE=$$FILE

 +4                IF FTYPE=""

                       SET DONE=1

                       QUIT

 +5                SET DATE=$$DATE

 +6                IF DATE=""

                       SET DONE=1

                       QUIT

 +7       ;

 +8                NEW BY,DHD,DIC,FLDS,FR,L,NOW,TO

 +9                SET FR="01/01/2000"

 +10               SET TO=DATE

 +11               SET BY="REVIEW DATE"

 +12               SET FLDS=".01,REVIEW DATE;C60"

 +13               SET L=0

 +14      ;

 +15               IF FTYPE="C"

                       SET DIC="^PXRMD(811.4,"

                       SET DHD="CF'S TO REVIEW"

 +16               IF FTYPE="D"

                       SET DIC="^PXRMD(801.41,"

                       SET DHD="DIALOGS TO REVIEW"

 +17               IF FTYPE="L"

                       SET DIC="^PXRMD(810.9,"

                       SET DHD="LOCATION LISTS TO REVIEW"

 +18               IF FTYPE="R"

                       SET DIC="^PXD(811.9,"

                       SET DHD="REMINDERS TO REVIEW"

 +19               IF FTYPE="S"

                       SET DIC="^PXRMD(811.6,"

                       SET DHD="SPONSORS TO REVIEW"

 +20               IF FTYPE="X"

                       SET DIC="^PXD(811.2,"

                       SET DHD="TAXONOMIES TO REVIEW"

 +21               IF FTYPE="O"

                       SET DIC="^PXD(801,"

                       SET DHD="ORDERABLE ITEM GROUPS TO REVIEW"

 +22               IF FTYPE="U"

                       SET DIC="^PXD(801.1,"

                       SET DHD="ORDER CHECK RULES TO REVIEW"

 +23               IF FTYPE="T"

                       SET DIC="^PXRMD(811.5,"

                       SET DHD="TERMS TO REVIEW"

 +24      ;

 +25               SET DHD=DHD_" (up to "_$$FMTE^XLFDT(DATE)_")"

 +26      ;Print

 +27               DO EN1^DIP

               End DoDot:1

 +28       QUIT

 +29      ;

PXRMREV.m