PXRMDLGZ ;SLC/PJH - Link reminder to dialog. ;05/10/2016 08:53
;;2.0;CLINICAL REMINDERS;**4,6,12,45**;Feb 04, 2005;Build 566
;
;Called by option PXRM DIALOG/COMPONENT EDIT
;
START N BY,DATA,DDES,DHD,DIC,DNAM,DTYP,FLDS,FR,L,LOGIC,NOW,PNAM,TO,Y
N PXRMBG,PXRMHD,PXRMDIEN,PXRMGTYP,PXRMDTST,PXRMDTYP,PXRMITEM,PXRMMODE,PXRMNAME
N PXRMTEMP,PXRMTITL,PXRMVIEW
;Refresh on return
S VALMBCK="R"
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
;Default is display dialog elements
S PXRMDTYP="R",PXRMGTYP="DLGR",PXRMVIEW="AN"
;Select dialog for display
F D Q:'PXRMTEMP
.S PXRMTEMP=""
.D START^PXRMSEL(.PXRMHD,.PXRMGTYP,"PXRMTEMP") Q:'PXRMTEMP
.N X S X="IORESET"
.D ENDR^%ZISS,@(PXRMGTYP_"("_PXRMTEMP_")")
END Q
;
;Reminder View
;-------------
DLGR(PXRMITEM) ;
N PXRMDIEN,PXRMCS1,PXRMCS2
;Format headings to include reminder and name
S DATA=$G(^PXD(811.9,PXRMITEM,0)),RNAM=$P(DATA,U),PNAM=$P(DATA,U,3)
S PXRMHD="REMINDER NAME: "_RNAM
;
;Dialog History
F D Q:'PXRMDIEN
.D START^PXRMDLGH(PXRMITEM,.PXRMDIEN,"PXRMDIEN") Q:'PXRMDIEN
.N PXRMHD,VALMBCK,VALMBG,VALMSG,VIEW,X,XMZ
.S DNAM=$P($G(^PXRMD(801.41,PXRMDIEN,0)),U)
.I +$P($G(^PXRMD(801.41,PXRMDIEN,0)),U,3)>0 S DNAM=DNAM_" (DISABLED)"
.S PXRMHD="REMINDER DIALOG NAME: "_DNAM
.S PXRMCS1=$$FILE^PXRMEXCS(801.41,PXRMDIEN)
.S X="IORESET"
.D ENDR^%ZISS,EN^VALM("PXRM DIALOG LIST")
.I PXRMDIEN,$D(^PXRMD(801.41,PXRMDIEN,0)) D
..S PXRMCS2=$$FILE^PXRMEXCS(801.41,PXRMDIEN) Q:+PXRMCS2=0
..Q:PXRMCS1=PXRMCS2
..D SEHIST^PXRMUTIL(801.41,"^PXRMD(801,41,",PXRMDIEN)
.W IORESET
.D KILL^%ZISS
Q
;
;Edit element/prompt/group
;-------------------------
DLGE(PXRMDIEN) ;
N LOCK,LFIND
;Check for Uneditable flag
S LOCK=$P($G(^PXRMD(801.41,PXRMTEMP,100)),U,4)
S LFIND=$P($G(^PXRMD(801.41,PXRMTEMP,1)),U,5)
I LOCK=1,$G(LFIND)'="",$G(LFIND)'["ORD",'$G(PXRMINST) D Q
.W !,"This item can not be edited" H 2
;
S PXRMHD="Dialog Name: ",PXRMDIEN=PXRMTEMP
;Format headings to include dialog name
S DATA=$G(^PXRMD(801.41,PXRMDIEN,0)),DDES=$P(DATA,U),DTYP=$P(DATA,U,4)
;Test
I DTYP="G" D DLG(PXRMDIEN) Q
;
S PXRMHD=PXRMHD_" "_DDES W PXRMHD,!
;Edit selected dialog
D EDIT^PXRMDEDT(DTYP,PXRMDIEN,0)
Q
;
;Reminder dialog view
;--------------------
DLG(PXRMDIEN) ;
S PXRMDIEN=PXRMTEMP
S PXRMNAME=$P($G(^PXRMD(801.41,PXRMDIEN,0)),U)
S PXRMITEM=$P($G(^PXRMD(801.41,PXRMDIEN,0)),U,2)
;Format headings to include dialog name
S PXRMHD=PXRMHD_PXRMNAME
;Check if the set is disable and add to header if disabled
I +$P(^PXRMD(801.41,PXRMDIEN,0),U,3)>0 S PXRMHD=PXRMHD_" (DISABLED)"
;Listman option
D EN^VALM("PXRM DIALOG LIST")
W IORESET
D KILL^%ZISS
Q
;
;Other subroutines
;
;Ask update or no
;----------------
ASK(YESNO) ;
N X,Y,TEXT,DIR
K DIROUT,DIRUT,DTOUT,DUOUT
S DIR(0)="YA0"
S DIR("A")="LINK THIS REMINDER TO DIALOG - "_$P(PXRMHD,": ",2)_": "
S DIR("B")="Y"
S DIR("?")="Enter Y or N. For detailed help type ??"
S DIR("??")=U_"D HLP^PXRMDLGY(1)"
D ^DIR K DIR
I $D(DIROUT) S DTOUT=1
I $D(DTOUT)!($D(DUOUT)) Q
S YESNO=$E(Y(0))
Q
;
;Display dialogs autogenerated from this reminder
;------------------------------------------------
DISP(RIEN) ;
N ARRAY,DSUB,FIRST
;Get OTHER dialogs
S FIRST=1,DSUB=""
F S DSUB=$O(^PXRMD(801.41,"AG",RIEN,DSUB)) Q:'DSUB D
.W !
.D:FIRST
..W "DIALOGS ALREADY GENERATED FROM THIS REMINDER:",!! S FIRST=0
.W ?20,$P($G(^PXRMD(801.41,DSUB,0)),U)
;
I 'FIRST W !
;
Q
;
;Display linked reminders
;------------------------
DISPL(DIEN) ;
N ARRAY,DLG,RSUB,FIRST,RNAM
S RSUB=$P($G(^PXRMD(801.41,DIEN,0)),U,2)
I RSUB W !!,"SOURCE REMINDER: "_$P($G(^PXD(811.9,RSUB,0)),U)
;Linked reminders
S FIRST=1,RNAM=""
F S RNAM=$O(^PXD(811.9,"B",RNAM)) Q:RNAM="" D
.S RSUB=$O(^PXD(811.9,"B",RNAM,"")) Q:'RSUB
.S DLG=$P($G(^PXD(811.9,RSUB,51)),U) Q:DLG'=DIEN
.W ! I FIRST W !,"REMINDERS ALREADY LINKED TO THIS DIALOG:",!! S FIRST=0
.W ?18,$P($G(^PXD(811.9,RSUB,0)),U)
Q
;
;Link a dialog (called by protocol PXRM DIALOG/REMINDER LINK)
;-------------
LINK(DIEN) ;
F D Q:$D(DTOUT)!$D(DUOUT)
.W IORESET
.S VALMBCK="R"
.;Display linked reminders
.D DISPL(DIEN)
.;
.N ANS,DIC,DIR,DLG,LIT1,PNAME,PXRMREM,REM
.S DIC("A")="SELECT A REMINDER TO LINK OR CHANGE: "
.S LIT1="You must select a reminder!"
.D SEL(811.9,"AEQMZ",.PXRMREM)
.Q:$D(DTOUT)!$D(DUOUT)
.S REM=$P(PXRMREM(1),U),PNAME=$P(PXRMREM(1),U,3)
.I PNAME]"" W !!,"REMINDER PRINT NAME: "_PNAME,!
.;Display related dialogs
.D DISP(REM)
.;Check if already linked
.S DLG=$P($G(^PXD(811.9,REM,51)),U)
.;Reconfirm to link reminder
.I 'DLG S ANS="" D ASK(.ANS) Q:ANS'="Y"
.;
.N DA,DR,DIE
.;Edit selected reminder
.S DA=REM
.;Settup local variables
.S DIE="^PXD(811.9,",DR=51
.;If no link force entry
.I 'DLG S DR=DR_"///"_PXRMNAME
.D ^DIE
Q
;
;Link a Reminder (called by protocol PXRM DIALOG LINK)
;---------------
RLINK(REM) ;
N DLG
;Re-display reminder name
W IORESET
W !,PXRMHD
;
N DA,DR,DIE
;Edit selected reminder
S DA=REM
;Settup local variables
S DIE="^PXD(811.9,",DR=51
;If no link force entry
D ^DIE
Q
;
;General help text routine.
;--------------------------
HLP(CALL) ;
N HTEXT
N DIWF,DIWL,DIWR,IC
S DIWF="C75",DIWL=0,DIWR=75
;
I CALL=1 D
.S HTEXT(1)="Enter Yes to link reminder to this dialog."
I CALL=2 D
.S HTEXT(1)="Enter Yes to link reminder to this dialog."
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
;
;Reminder selection
;------------------
SEL(FILE,MODE,ARRAY) ;
N X,Y,CNT
K DIROUT,DIRUT,DTOUT,DUOUT
S CNT=0
W !
F D Q:$D(DTOUT) Q:$D(DUOUT) Q:CNT>0 Q:(Y=-1)&(CNT>0)
.S DIC=FILE,DIC(0)=MODE
.D ^DIC
.I X=(U_U) S DTOUT=1
.I '$D(DTOUT),('$D(DUOUT)) D
..I +Y'=-1 D Q
...S CNT=CNT+1,ARRAY(CNT)=Y_U_Y(0,0)_U_$P(Y(0),U,3)
..W:CNT=0 !,LIT1
.K DIC
Q
;
;Input transform for FINDING ITEM in 801.41
XINP(X) ;Taxonomy findings are not allowed for dialog groups
I $P(X,";",2)="PXD(811.2,",$P($G(^PXRMD(801.41,DA,0)),U,4)="G" D Q 0
.W $C(7),!,"A taxonomy cannot be entered as the finding item for a group"
;Only applies to MH
I $P(X,";",2)'="^YTT(601.71," Q 1
I $$OK^PXRMDLL($P(X,";")) Q 1
W *7,!,"This test is not appropriate for the GUI",!
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDLGZ 6531 printed Apr 09, 2024@20:55:13 Page 2
PXRMDLGZ ;SLC/PJH - Link reminder to dialog. ;05/10/2016 08:53
+1 ;;2.0;CLINICAL REMINDERS;**4,6,12,45**;Feb 04, 2005;Build 566
+2 ;
+3 ;Called by option PXRM DIALOG/COMPONENT EDIT
+4 ;
START NEW BY,DATA,DDES,DHD,DIC,DNAM,DTYP,FLDS,FR,L,LOGIC,NOW,PNAM,TO,Y
+1 NEW PXRMBG,PXRMHD,PXRMDIEN,PXRMGTYP,PXRMDTST,PXRMDTYP,PXRMITEM,PXRMMODE,PXRMNAME
+2 NEW PXRMTEMP,PXRMTITL,PXRMVIEW
+3 ;Refresh on return
+4 SET VALMBCK="R"
+5 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+6 ;Default is display dialog elements
+7 SET PXRMDTYP="R"
SET PXRMGTYP="DLGR"
SET PXRMVIEW="AN"
+8 ;Select dialog for display
+9 FOR
Begin DoDot:1
+10 SET PXRMTEMP=""
+11 DO START^PXRMSEL(.PXRMHD,.PXRMGTYP,"PXRMTEMP")
if 'PXRMTEMP
QUIT
+12 NEW X
SET X="IORESET"
+13 DO ENDR^%ZISS
DO @(PXRMGTYP_"("_PXRMTEMP_")")
End DoDot:1
if 'PXRMTEMP
QUIT
END QUIT
+1 ;
+2 ;Reminder View
+3 ;-------------
DLGR(PXRMITEM) ;
+1 NEW PXRMDIEN,PXRMCS1,PXRMCS2
+2 ;Format headings to include reminder and name
+3 SET DATA=$GET(^PXD(811.9,PXRMITEM,0))
SET RNAM=$PIECE(DATA,U)
SET PNAM=$PIECE(DATA,U,3)
+4 SET PXRMHD="REMINDER NAME: "_RNAM
+5 ;
+6 ;Dialog History
+7 FOR
Begin DoDot:1
+8 DO START^PXRMDLGH(PXRMITEM,.PXRMDIEN,"PXRMDIEN")
if 'PXRMDIEN
QUIT
+9 NEW PXRMHD,VALMBCK,VALMBG,VALMSG,VIEW,X,XMZ
+10 SET DNAM=$PIECE($GET(^PXRMD(801.41,PXRMDIEN,0)),U)
+11 IF +$PIECE($GET(^PXRMD(801.41,PXRMDIEN,0)),U,3)>0
SET DNAM=DNAM_" (DISABLED)"
+12 SET PXRMHD="REMINDER DIALOG NAME: "_DNAM
+13 SET PXRMCS1=$$FILE^PXRMEXCS(801.41,PXRMDIEN)
+14 SET X="IORESET"
+15 DO ENDR^%ZISS
DO EN^VALM("PXRM DIALOG LIST")
+16 IF PXRMDIEN
IF $DATA(^PXRMD(801.41,PXRMDIEN,0))
Begin DoDot:2
+17 SET PXRMCS2=$$FILE^PXRMEXCS(801.41,PXRMDIEN)
if +PXRMCS2=0
QUIT
+18 if PXRMCS1=PXRMCS2
QUIT
+19 DO SEHIST^PXRMUTIL(801.41,"^PXRMD(801,41,",PXRMDIEN)
End DoDot:2
+20 WRITE IORESET
+21 DO KILL^%ZISS
End DoDot:1
if 'PXRMDIEN
QUIT
+22 QUIT
+23 ;
+24 ;Edit element/prompt/group
+25 ;-------------------------
DLGE(PXRMDIEN) ;
+1 NEW LOCK,LFIND
+2 ;Check for Uneditable flag
+3 SET LOCK=$PIECE($GET(^PXRMD(801.41,PXRMTEMP,100)),U,4)
+4 SET LFIND=$PIECE($GET(^PXRMD(801.41,PXRMTEMP,1)),U,5)
+5 IF LOCK=1
IF $GET(LFIND)'=""
IF $GET(LFIND)'["ORD"
IF '$GET(PXRMINST)
Begin DoDot:1
+6 WRITE !,"This item can not be edited"
HANG 2
End DoDot:1
QUIT
+7 ;
+8 SET PXRMHD="Dialog Name: "
SET PXRMDIEN=PXRMTEMP
+9 ;Format headings to include dialog name
+10 SET DATA=$GET(^PXRMD(801.41,PXRMDIEN,0))
SET DDES=$PIECE(DATA,U)
SET DTYP=$PIECE(DATA,U,4)
+11 ;Test
+12 IF DTYP="G"
DO DLG(PXRMDIEN)
QUIT
+13 ;
+14 SET PXRMHD=PXRMHD_" "_DDES
WRITE PXRMHD,!
+15 ;Edit selected dialog
+16 DO EDIT^PXRMDEDT(DTYP,PXRMDIEN,0)
+17 QUIT
+18 ;
+19 ;Reminder dialog view
+20 ;--------------------
DLG(PXRMDIEN) ;
+1 SET PXRMDIEN=PXRMTEMP
+2 SET PXRMNAME=$PIECE($GET(^PXRMD(801.41,PXRMDIEN,0)),U)
+3 SET PXRMITEM=$PIECE($GET(^PXRMD(801.41,PXRMDIEN,0)),U,2)
+4 ;Format headings to include dialog name
+5 SET PXRMHD=PXRMHD_PXRMNAME
+6 ;Check if the set is disable and add to header if disabled
+7 IF +$PIECE(^PXRMD(801.41,PXRMDIEN,0),U,3)>0
SET PXRMHD=PXRMHD_" (DISABLED)"
+8 ;Listman option
+9 DO EN^VALM("PXRM DIALOG LIST")
+10 WRITE IORESET
+11 DO KILL^%ZISS
+12 QUIT
+13 ;
+14 ;Other subroutines
+15 ;
+16 ;Ask update or no
+17 ;----------------
ASK(YESNO) ;
+1 NEW X,Y,TEXT,DIR
+2 KILL DIROUT,DIRUT,DTOUT,DUOUT
+3 SET DIR(0)="YA0"
+4 SET DIR("A")="LINK THIS REMINDER TO DIALOG - "_$PIECE(PXRMHD,": ",2)_": "
+5 SET DIR("B")="Y"
+6 SET DIR("?")="Enter Y or N. For detailed help type ??"
+7 SET DIR("??")=U_"D HLP^PXRMDLGY(1)"
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DIROUT)
SET DTOUT=1
+10 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+11 SET YESNO=$EXTRACT(Y(0))
+12 QUIT
+13 ;
+14 ;Display dialogs autogenerated from this reminder
+15 ;------------------------------------------------
DISP(RIEN) ;
+1 NEW ARRAY,DSUB,FIRST
+2 ;Get OTHER dialogs
+3 SET FIRST=1
SET DSUB=""
+4 FOR
SET DSUB=$ORDER(^PXRMD(801.41,"AG",RIEN,DSUB))
if 'DSUB
QUIT
Begin DoDot:1
+5 WRITE !
+6 if FIRST
Begin DoDot:2
+7 WRITE "DIALOGS ALREADY GENERATED FROM THIS REMINDER:",!!
SET FIRST=0
End DoDot:2
+8 WRITE ?20,$PIECE($GET(^PXRMD(801.41,DSUB,0)),U)
End DoDot:1
+9 ;
+10 IF 'FIRST
WRITE !
+11 ;
+12 QUIT
+13 ;
+14 ;Display linked reminders
+15 ;------------------------
DISPL(DIEN) ;
+1 NEW ARRAY,DLG,RSUB,FIRST,RNAM
+2 SET RSUB=$PIECE($GET(^PXRMD(801.41,DIEN,0)),U,2)
+3 IF RSUB
WRITE !!,"SOURCE REMINDER: "_$PIECE($GET(^PXD(811.9,RSUB,0)),U)
+4 ;Linked reminders
+5 SET FIRST=1
SET RNAM=""
+6 FOR
SET RNAM=$ORDER(^PXD(811.9,"B",RNAM))
if RNAM=""
QUIT
Begin DoDot:1
+7 SET RSUB=$ORDER(^PXD(811.9,"B",RNAM,""))
if 'RSUB
QUIT
+8 SET DLG=$PIECE($GET(^PXD(811.9,RSUB,51)),U)
if DLG'=DIEN
QUIT
+9 WRITE !
IF FIRST
WRITE !,"REMINDERS ALREADY LINKED TO THIS DIALOG:",!!
SET FIRST=0
+10 WRITE ?18,$PIECE($GET(^PXD(811.9,RSUB,0)),U)
End DoDot:1
+11 QUIT
+12 ;
+13 ;Link a dialog (called by protocol PXRM DIALOG/REMINDER LINK)
+14 ;-------------
LINK(DIEN) ;
+1 FOR
Begin DoDot:1
+2 WRITE IORESET
+3 SET VALMBCK="R"
+4 ;Display linked reminders
+5 DO DISPL(DIEN)
+6 ;
+7 NEW ANS,DIC,DIR,DLG,LIT1,PNAME,PXRMREM,REM
+8 SET DIC("A")="SELECT A REMINDER TO LINK OR CHANGE: "
+9 SET LIT1="You must select a reminder!"
+10 DO SEL(811.9,"AEQMZ",.PXRMREM)
+11 if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+12 SET REM=$PIECE(PXRMREM(1),U)
SET PNAME=$PIECE(PXRMREM(1),U,3)
+13 IF PNAME]""
WRITE !!,"REMINDER PRINT NAME: "_PNAME,!
+14 ;Display related dialogs
+15 DO DISP(REM)
+16 ;Check if already linked
+17 SET DLG=$PIECE($GET(^PXD(811.9,REM,51)),U)
+18 ;Reconfirm to link reminder
+19 IF 'DLG
SET ANS=""
DO ASK(.ANS)
if ANS'="Y"
QUIT
+20 ;
+21 NEW DA,DR,DIE
+22 ;Edit selected reminder
+23 SET DA=REM
+24 ;Settup local variables
+25 SET DIE="^PXD(811.9,"
SET DR=51
+26 ;If no link force entry
+27 IF 'DLG
SET DR=DR_"///"_PXRMNAME
+28 DO ^DIE
End DoDot:1
if $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+29 QUIT
+30 ;
+31 ;Link a Reminder (called by protocol PXRM DIALOG LINK)
+32 ;---------------
RLINK(REM) ;
+1 NEW DLG
+2 ;Re-display reminder name
+3 WRITE IORESET
+4 WRITE !,PXRMHD
+5 ;
+6 NEW DA,DR,DIE
+7 ;Edit selected reminder
+8 SET DA=REM
+9 ;Settup local variables
+10 SET DIE="^PXD(811.9,"
SET DR=51
+11 ;If no link force entry
+12 DO ^DIE
+13 QUIT
+14 ;
+15 ;General help text routine.
+16 ;--------------------------
HLP(CALL) ;
+1 NEW HTEXT
+2 NEW DIWF,DIWL,DIWR,IC
+3 SET DIWF="C75"
SET DIWL=0
SET DIWR=75
+4 ;
+5 IF CALL=1
Begin DoDot:1
+6 SET HTEXT(1)="Enter Yes to link reminder to this dialog."
End DoDot:1
+7 IF CALL=2
Begin DoDot:1
+8 SET HTEXT(1)="Enter Yes to link reminder to this dialog."
End DoDot:1
+9 KILL ^UTILITY($JOB,"W")
+10 SET IC=""
+11 FOR
SET IC=$ORDER(HTEXT(IC))
if IC=""
QUIT
Begin DoDot:1
+12 SET X=HTEXT(IC)
+13 DO ^DIWP
End DoDot:1
+14 WRITE !
+15 SET IC=0
+16 FOR
SET IC=$ORDER(^UTILITY($JOB,"W",0,IC))
if IC=""
QUIT
Begin DoDot:1
+17 WRITE !,^UTILITY($JOB,"W",0,IC,0)
End DoDot:1
+18 KILL ^UTILITY($JOB,"W")
+19 WRITE !
+20 QUIT
+21 ;
+22 ;Reminder selection
+23 ;------------------
SEL(FILE,MODE,ARRAY) ;
+1 NEW X,Y,CNT
+2 KILL DIROUT,DIRUT,DTOUT,DUOUT
+3 SET CNT=0
+4 WRITE !
+5 FOR
Begin DoDot:1
+6 SET DIC=FILE
SET DIC(0)=MODE
+7 DO ^DIC
+8 IF X=(U_U)
SET DTOUT=1
+9 IF '$DATA(DTOUT)
IF ('$DATA(DUOUT))
Begin DoDot:2
+10 IF +Y'=-1
Begin DoDot:3
+11 SET CNT=CNT+1
SET ARRAY(CNT)=Y_U_Y(0,0)_U_$PIECE(Y(0),U,3)
End DoDot:3
QUIT
+12 if CNT=0
WRITE !,LIT1
End DoDot:2
+13 KILL DIC
End DoDot:1
if $DATA(DTOUT)
QUIT
if $DATA(DUOUT)
QUIT
if CNT>0
QUIT
if (Y=-1)&(CNT>0)
QUIT
+14 QUIT
+15 ;
+16 ;Input transform for FINDING ITEM in 801.41
XINP(X) ;Taxonomy findings are not allowed for dialog groups
+1 IF $PIECE(X,";",2)="PXD(811.2,"
IF $PIECE($GET(^PXRMD(801.41,DA,0)),U,4)="G"
Begin DoDot:1
+2 WRITE $CHAR(7),!,"A taxonomy cannot be entered as the finding item for a group"
End DoDot:1
QUIT 0
+3 ;Only applies to MH
+4 IF $PIECE(X,";",2)'="^YTT(601.71,"
QUIT 1
+5 IF $$OK^PXRMDLL($PIECE(X,";"))
QUIT 1
+6 WRITE *7,!,"This test is not appropriate for the GUI",!
+7 QUIT 0
