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
Q
;
;Labels called from list 'PXRM DIALOG HISTORY'
;
EXIT ;Exit code
D CLEAN^VALM10,FULL^VALM1
S VALMBCK="Q"
K ^TMP("PXRMDLGH",$J)
Q
;
HDR ; Header code
S VALMHDR(1)=PXRMHD
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
Q
;
HELP ;Help code
N ORU,ORUPRMT,XQORM,PXRMTAG
S PXRMTAG="GDLGH"
D EN^VALM("PXRM DIALOG MAIN HELP")
Q
;
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
Q
;
PEXIT ;PXRM DIALOG HISTORY MENU protocol exit code
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
D XQORM
Q
;
;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
;
Q
;
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
Q
;
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
Q
;
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)=""
Q
;
XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM SELECTION ITEM",0))_U_"1:"_VALMCNT
S XQORM("A")="Select Item: "
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDLGH 4222 printed Dec 13, 2024@01:44 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
