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 !
Q
;
;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
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMREV 3046 printed Oct 16, 2024@17:49:41 Page 2
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 ;
