- 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 Feb 18, 2025@23:10:24 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