Routine: PXRMDLGH

PXRMDLGH ; SLC/PJH - Reminder Dialog History ;08/16/2001

 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 ;Called from PXRMDLGZ

START(PXRMITEM,PXRMDIEN,PXRMNAM) ;

 N PXRMBG,PXRMLINK,PXRMREAD,PXRMSRC,PXRMVARM

 N VALM,VALMAR,VALMBCK,VALMBG,VALMCNT,VALMHDR,VALMSG,X,XMZ

 S X="IORESET",PXRMLINK=$P($G(^PXD(811.9,PXRMITEM,51)),U),PXRMDIEN=""

 D ENDR^%ZISS,EN^VALM("PXRM DIALOG HISTORY")

 W IORESET

 D KILL^%ZISS

 ;Labels called from list 'PXRM DIALOG HISTORY'

EXIT ;Exit code

 D CLEAN^VALM10,FULL^VALM1

 S VALMBCK="Q"

 K ^TMP("PXRMDLGH",$J)

HDR ; Header code

 S VALMHDR(1)=PXRMHD

 S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

HELP ;Help code

 N ORU,ORUPRMT,XQORM,PXRMTAG

 S PXRMTAG="GDLGH"

 D EN^VALM("PXRM DIALOG MAIN HELP")

INIT ;Init

 S VALMCNT=0

 ;Get linked dialog

 S PXRMLINK=$P($G(^PXD(811.9,PXRMITEM,51)),U)

 ;Load details of reminder dialog

 D BUILD(PXRMITEM,PXRMLINK)

 ;Reset Menu

 D XQORM

PEXIT ;PXRM DIALOG HISTORY MENU protocol exit code

 S VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

 D XQORM

 ;Other Subroutines

 ;Build workfile (Entry action for protocol PXRM DIALOG HISTORY)

BUILD(PXRMITEM,PXRMLINK) ;

 N ARRAY,DARRAY,DDAT,DIEN,DNAM,DSEQ,FIRST,HDR,RIEN,RNAM,TXT

 ;Clear existing file

 S VALMCNT=0,VALMBCK="R",FIRST=1,DSEQ=0 K ^TMP("PXRMDLG",$J)

 ;Get the linked dialog first

 I PXRMLINK D

 .S VALMCNT=VALMCNT+1

 .S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",79)

 .S VALMCNT=VALMCNT+1

 .S ^TMP("PXRMDLG",$J,VALMCNT,0)="This reminder is linked to dialog:"

 .S VALMCNT=VALMCNT+1

 .S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",79)

 .D SET(PXRMITEM,PXRMLINK)

 .;Get list of other reminders and display

 .D OTHER(PXRMLINK),OLST("")

 ;Then other dialogs generated from this reminder (ALPHA order)

 S DIEN=""

 F  S DIEN=$O(^PXRMD(801.41,"AG",PXRMITEM,DIEN)) Q:'DIEN  D

 .Q:DIEN=PXRMLINK

 .S DNAM=$P($G(^PXRMD(801.41,DIEN,0)),U) Q:DNAM=""

 .S DARRAY(DNAM)=DIEN

 S DNAM="",HDR=1

 F  S DNAM=$O(DARRAY(DNAM)) Q:DNAM=""  D

 .S DIEN=DARRAY(DNAM) Q:'DIEN

 .S RIEN=$P($G(^PXD(811.9,DIEN,51)),U),FIRST=1

 .;Get list of other reminders

 .D OTHER(DIEN)

 .;Other dialogs header

 .I HDR D

 ..S VALMCNT=VALMCNT+1

 ..S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",79)

 ..S VALMCNT=VALMCNT+1

 ..S ^TMP("PXRMDLG",$J,VALMCNT,0)="Other dialogs generated from this reminder:"

 ..S VALMCNT=VALMCNT+1,HDR=0

 ..S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",79)

 .;If this reminder isn't linked display the one that is

 .I 'RIEN D

 ..N RNAM

 ..S RNAM=$O(ARRAY("")) Q:RNAM=""

 ..S RIEN=$G(ARRAY(RNAM)) S:RIEN FIRST=0

 .;Dialog detail

 .D SET(RIEN,DIEN)

 .;Additional reminder detail

 .S:FIRST RIEN="" D OLST(RIEN)

 I VALMCNT=0 D

 .S VALMCNT=VALMCNT+1

 .S ^TMP("PXRMDLG",$J,VALMCNT,0)="    * NO DIALOGS DEFINED *"

 S VALMCNT=VALMCNT+1

 S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",79)

 S ^TMP("PXRMDLG",$J,"VALMCNT")=VALMCNT

OTHER(DIEN) ;Other reminders linked to this dialog

 N DLG,DNAM,RNAM,RSUB

 ;Linked reminders

 S RNAM="" K ARRAY

 F  S RNAM=$O(^PXD(811.9,"B",RNAM)) Q:RNAM=""  D

 .S RSUB=$O(^PXD(811.9,"B",RNAM,"")) Q:'RSUB  D

 ..S DLG=$P($G(^PXD(811.9,RSUB,51)),U) Q:DLG'=DIEN

 ..S RNAM=$P($G(^PXD(811.9,RSUB,0)),U) Q:RNAM=""

 ..S ARRAY(RNAM)=RSUB

OLST(REM) ;List Other Reminders

 N RNAM

 S RNAM=""

 F  S RNAM=$O(ARRAY(RNAM)) Q:RNAM=""  D

 .Q:ARRAY(RNAM)=REM  Q:ARRAY(RNAM)=PXRMITEM

 .S VALMCNT=VALMCNT+1

 .S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",59)_RNAM

SET(RIEN,DIEN) ;

 N RNAM,DNAM,DDAT

 S RNAM="*NONE*",DSEQ=DSEQ+1

 ;Dialog details

 S DNAM=$P($G(^PXRMD(801.41,DIEN,0)),U)

 S DDAT=$P($G(^PXRMD(801.41,DIEN,99)),U,1)

 S:DDAT="" DDAT=$P($G(^PXRMD(801.41,DIEN,99)),U,2)

 S DDAT=$$FMTE^XLFDT(DDAT,"1D")

 ;Reminder details

 I RIEN D

 .S RNAM=$P($G(^PXD(811.9,RIEN,0)),U)

 .I RIEN=PXRMITEM S RNAM=""

 ;Update display

 S TXT=$J(DSEQ,4)_"  "_$E(DNAM,1,32)_$J("",32-$L(DNAM))

 S TXT=TXT_" "_DDAT_$J("",20-$L(DDAT))_RNAM

 S VALMCNT=VALMCNT+1

 S ^TMP("PXRMDLG",$J,VALMCNT,0)=TXT

 S ^TMP("PXRMDLG",$J,"IDX",DSEQ,DIEN)=""

XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM SELECTION ITEM",0))_U_"1:"_VALMCNT

 S XQORM("A")="Select Item: "

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDLGH   4222     printed  Apr 23, 2025@17:58:27                                                                                                                                                                                                    Page 2

PXRMDLGH  ; SLC/PJH - Reminder Dialog History ;08/16/2001

 +1       ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005

 +2       ;

 +3       ;Called from PXRMDLGZ

 +4       ;

START(PXRMITEM,PXRMDIEN,PXRMNAM) ;

 +1        NEW PXRMBG,PXRMLINK,PXRMREAD,PXRMSRC,PXRMVARM

 +2        NEW VALM,VALMAR,VALMBCK,VALMBG,VALMCNT,VALMHDR,VALMSG,X,XMZ

 +3        SET X="IORESET"

           SET PXRMLINK=$PIECE($GET(^PXD(811.9,PXRMITEM,51)),U)

           SET PXRMDIEN=""

 +4        DO ENDR^%ZISS

           DO EN^VALM("PXRM DIALOG HISTORY")

 +5        WRITE IORESET

 +6        DO KILL^%ZISS

 +7        QUIT

 +8       ;

 +9       ;Labels called from list 'PXRM DIALOG HISTORY'

 +10      ;

EXIT      ;Exit code

 +1        DO CLEAN^VALM10

           DO FULL^VALM1

 +2        SET VALMBCK="Q"

 +3        KILL ^TMP("PXRMDLGH",$JOB)

 +4        QUIT

 +5       ;

HDR       ; Header code

 +1        SET VALMHDR(1)=PXRMHD

 +2        SET VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

 +3        QUIT

 +4       ;

HELP      ;Help code

 +1        NEW ORU,ORUPRMT,XQORM,PXRMTAG

 +2        SET PXRMTAG="GDLGH"

 +3        DO EN^VALM("PXRM DIALOG MAIN HELP")

 +4        QUIT

 +5       ;

INIT      ;Init

 +1        SET VALMCNT=0

 +2       ;Get linked dialog

 +3        SET PXRMLINK=$PIECE($GET(^PXD(811.9,PXRMITEM,51)),U)

 +4       ;Load details of reminder dialog

 +5        DO BUILD(PXRMITEM,PXRMLINK)

 +6       ;Reset Menu

 +7        DO XQORM

 +8        QUIT

 +9       ;

PEXIT     ;PXRM DIALOG HISTORY MENU protocol exit code

 +1        SET VALMSG="+ Next Screen   - Prev Screen   ?? More Actions"

 +2        DO XQORM

 +3        QUIT

 +4       ;

 +5       ;Other Subroutines

 +6       ;

 +7       ;Build workfile (Entry action for protocol PXRM DIALOG HISTORY)

BUILD(PXRMITEM,PXRMLINK) ;

 +1       ;

 +2        NEW ARRAY,DARRAY,DDAT,DIEN,DNAM,DSEQ,FIRST,HDR,RIEN,RNAM,TXT

 +3       ;Clear existing file

 +4        SET VALMCNT=0

           SET VALMBCK="R"

           SET FIRST=1

           SET DSEQ=0

           KILL ^TMP("PXRMDLG",$JOB)

 +5       ;Get the linked dialog first

 +6        IF PXRMLINK

               Begin DoDot:1

 +7                SET VALMCNT=VALMCNT+1

 +8                SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=$JUSTIFY("",79)

 +9                SET VALMCNT=VALMCNT+1

 +10               SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)="This reminder is linked to dialog:"

 +11               SET VALMCNT=VALMCNT+1

 +12               SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=$JUSTIFY("",79)

 +13               DO SET(PXRMITEM,PXRMLINK)

 +14      ;Get list of other reminders and display

 +15               DO OTHER(PXRMLINK)

                   DO OLST("")

               End DoDot:1

 +16      ;

 +17      ;Then other dialogs generated from this reminder (ALPHA order)

 +18       SET DIEN=""

 +19       FOR

               SET DIEN=$ORDER(^PXRMD(801.41,"AG",PXRMITEM,DIEN))

               if 'DIEN

                   QUIT

               Begin DoDot:1

 +20               if DIEN=PXRMLINK

                       QUIT

 +21               SET DNAM=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)

                   if DNAM=""

                       QUIT

 +22               SET DARRAY(DNAM)=DIEN

               End DoDot:1

 +23      ;

 +24       SET DNAM=""

           SET HDR=1

 +25       FOR

               SET DNAM=$ORDER(DARRAY(DNAM))

               if DNAM=""

                   QUIT

               Begin DoDot:1

 +26               SET DIEN=DARRAY(DNAM)

                   if 'DIEN

                       QUIT

 +27               SET RIEN=$PIECE($GET(^PXD(811.9,DIEN,51)),U)

                   SET FIRST=1

 +28      ;Get list of other reminders

 +29               DO OTHER(DIEN)

 +30      ;Other dialogs header

 +31               IF HDR

                       Begin DoDot:2

 +32                       SET VALMCNT=VALMCNT+1

 +33                       SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=$JUSTIFY("",79)

 +34                       SET VALMCNT=VALMCNT+1

 +35                       SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)="Other dialogs generated from this reminder:"

 +36                       SET VALMCNT=VALMCNT+1

                           SET HDR=0

 +37                       SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=$JUSTIFY("",79)

                       End DoDot:2

 +38      ;If this reminder isn't linked display the one that is

 +39               IF 'RIEN

                       Begin DoDot:2

 +40                       NEW RNAM

 +41                       SET RNAM=$ORDER(ARRAY(""))

                           if RNAM=""

                               QUIT

 +42                       SET RIEN=$GET(ARRAY(RNAM))

                           if RIEN

                               SET FIRST=0

                       End DoDot:2

 +43      ;Dialog detail

 +44               DO SET(RIEN,DIEN)

 +45      ;Additional reminder detail

 +46               if FIRST

                       SET RIEN=""

                   DO OLST(RIEN)

               End DoDot:1

 +47      ;

 +48       IF VALMCNT=0

               Begin DoDot:1

 +49               SET VALMCNT=VALMCNT+1

 +50               SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)="    * NO DIALOGS DEFINED *"

               End DoDot:1

 +51      ;

 +52       SET VALMCNT=VALMCNT+1

 +53       SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=$JUSTIFY("",79)

 +54       SET ^TMP("PXRMDLG",$JOB,"VALMCNT")=VALMCNT

 +55      ;

 +56       QUIT

 +57      ;

OTHER(DIEN) ;Other reminders linked to this dialog

 +1        NEW DLG,DNAM,RNAM,RSUB

 +2       ;Linked reminders

 +3        SET RNAM=""

           KILL ARRAY

 +4        FOR

               SET RNAM=$ORDER(^PXD(811.9,"B",RNAM))

               if RNAM=""

                   QUIT

               Begin DoDot:1

 +5                SET RSUB=$ORDER(^PXD(811.9,"B",RNAM,""))

                   if 'RSUB

                       QUIT

                   Begin DoDot:2

 +6                    SET DLG=$PIECE($GET(^PXD(811.9,RSUB,51)),U)

                       if DLG'=DIEN

                           QUIT

 +7                    SET RNAM=$PIECE($GET(^PXD(811.9,RSUB,0)),U)

                       if RNAM=""

                           QUIT

 +8                    SET ARRAY(RNAM)=RSUB

                   End DoDot:2

               End DoDot:1

 +9        QUIT

 +10      ;

OLST(REM) ;List Other Reminders

 +1        NEW RNAM

 +2        SET RNAM=""

 +3        FOR

               SET RNAM=$ORDER(ARRAY(RNAM))

               if RNAM=""

                   QUIT

               Begin DoDot:1

 +4                if ARRAY(RNAM)=REM

                       QUIT

                   if ARRAY(RNAM)=PXRMITEM

                       QUIT

 +5                SET VALMCNT=VALMCNT+1

 +6                SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=$JUSTIFY("",59)_RNAM

               End DoDot:1

 +7        QUIT

 +8       ;

SET(RIEN,DIEN) ;

 +1        NEW RNAM,DNAM,DDAT

 +2        SET RNAM="*NONE*"

           SET DSEQ=DSEQ+1

 +3       ;Dialog details

 +4        SET DNAM=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U)

 +5        SET DDAT=$PIECE($GET(^PXRMD(801.41,DIEN,99)),U,1)

 +6        if DDAT=""

               SET DDAT=$PIECE($GET(^PXRMD(801.41,DIEN,99)),U,2)

 +7        SET DDAT=$$FMTE^XLFDT(DDAT,"1D")

 +8       ;Reminder details

 +9        IF RIEN

               Begin DoDot:1

 +10               SET RNAM=$PIECE($GET(^PXD(811.9,RIEN,0)),U)

 +11               IF RIEN=PXRMITEM

                       SET RNAM=""

               End DoDot:1

 +12      ;Update display

 +13       SET TXT=$JUSTIFY(DSEQ,4)_"  "_$EXTRACT(DNAM,1,32)_$JUSTIFY("",32-$LENGTH(DNAM))

 +14       SET TXT=TXT_" "_DDAT_$JUSTIFY("",20-$LENGTH(DDAT))_RNAM

 +15       SET VALMCNT=VALMCNT+1

 +16       SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=TXT

 +17       SET ^TMP("PXRMDLG",$JOB,"IDX",DSEQ,DIEN)=""

 +18       QUIT

 +19      ;

XQORM      SET XQORM("#")=$ORDER(^ORD(101,"B","PXRM SELECTION ITEM",0))_U_"1:"_VALMCNT

 +1        SET XQORM("A")="Select Item: "

 +2        QUIT

PXRMDLGH.m