PXRMDLG5 ;SLC/PJH - Reminder Dialog Edit/Inquiry ;05/02/2017
;;2.0;CLINICAL REMINDERS;**4,6,12,45**;Feb 04, 2005;Build 566
;
ALT(DIEN,LEV,DSEQ,NODE,VIEW,NLINE,CNT,ALTLEN) ;
;Display branching logic text in dialog summary view
N ACT,IEN,DNAME,ESTATUS,EVNAME,LINK,NAME,SEQ,STAT,X0
S SEQ=0 F S SEQ=$O(^PXRMD(801.41,DIEN,"BL","B",SEQ)) Q:SEQ'>0 D
.S IEN=$O(^PXRMD(801.41,DIEN,"BL","B",SEQ,"")) Q:IEN'>0
.S X0=$G(^PXRMD(801.41,DIEN,"BL",IEN,0))
.S ACT=$S($P(X0,U,4)="H":"Hide if",$P(X0,U,4)="R":"Replaced by",$P(X0,U,4)="C":"Check checkbox for item",$P(X0,U,4)="S":"Suppress checkbox for item",$P(X0,U,4)="L":"Perform Link",1:"") Q:ACT=""
.S LINK=$S($P(X0,U,4)="L":$P($G(^PXRMD(801.48,$P(X0,U,7),0)),U),1:"")
.S STAT=$P(X0,U,3)
.S ESTATUS=$S(STAT="D":"Due",STAT="A":"Applicable",STAT="N":"N/A",STAT="F":"False",STAT="T":"True",1:"")
.S DNAME="" I $P(X0,U,5)>0 S DNAME=$P($G(^PXRMD(801.41,$P(X0,U,5),0)),U)
.I $P(X0,U,4)="C"!($P(X0,U,4)="S") S DNAME=$P(^PXRMD(801.41,DIEN,0),U)
.S IEN=+$P(X0,U,2)
.I $P(X0,U,2)["811.9" S NAME=$P($G(^PXD(811.9,IEN,0)),U) Q:NAME="" S EVNAME="Reminder Definition "_NAME
.I $P(X0,U,2)["811.5" S NAME=$P($G(^PXRMD(811.5,IEN,0)),U) Q:NAME="" S EVNAME="Reminder Term "_NAME
.S TEMP="Sequence "_SEQ_" "_ACT_$S(DNAME'="":" "_DNAME_" if ",LINK'="":" "_LINK_" if ",1:" ")_EVNAME_" evaluates as "_ESTATUS
.D TEXT(.NLINES,CNT,ALTLEN,TEMP,NODE)
Q
;
ASK(YESNO,PIEN) ;Confirm
K DIR,DIROUT,DIRUT,DNAME,DTOUT,DTYP,DUOUT,TEXT,X,Y
N DDATA,DNAME,DTYP
S DDATA=$G(^PXRMD(801.41,PIEN,0))
;Parent name and type
S DNAME=$P(DDATA,U),DTYP=$P(DDATA,U,4)
;
S DIR(0)="YA0"
S DIR("A")="Add sequence "_SEQ_" to "
I DTYP="G" S DIR("A")=DIR("A")_"group "_DNAME_": "
E S DIR("A")=DIR("A")_"reminder dialog ?: "
S DIR("B")="N",DIR("?")="Enter Y or N. For detailed help type ??"
S DIR("??")=U_"D XHLP^PXRMDLG(1)"
D ^DIR K DIR
I $D(DIROUT) S DTOUT=1
I $D(DTOUT)!($D(DUOUT)) Q
S YESNO=$E(Y(0)) I YESNO'="Y" S DUOUT=1
S VALMBCK="R"
Q
;
BHELP(VALUE) ;
N HTEXT
D FULL^VALM1
;Help text for Reminder Dialog Branching logic
I VALUE=1 D
.;Reminder Term field
.S HTEXT(1)="Enter a reminder term that will be used to determine if the reminder"
.S HTEXT(2)="element/group should be replaced or suppressed if the reminder term evaluation"
.S HTEXT(3)="matches the value in the Reminder Term Status field."
I VALUE=2 D
.;Reminder Term Status field
.S HTEXT(1)="Enter either 1 for true or 0 for false. This value will be used with the"
.S HTEXT(2)="reminder term field to determine if this item should be replaced with a"
.S HTEXT(3)="different element/group defined in the Replacement Element/Group field, or if"
.S HTEXT(4)="this item should be suppressed."
I VALUE=3 D
.;Replacement Element/Group field
.S HTEXT(1)="Enter an element/group that will be used as a replacement to thisitem, or"
.S HTEXT(2)="leave this field blank to suppress this item if the term evaluation"
.S HTEXT(3)="matches the value defined in the term status field. "
I VALUE=4 D
.;Patient Specific field
.S HTEXT(1)="Enter either 1 for true or 0 for false. This value must be set to true"
.S HTEXT(2)="if item in this dialog will be using reminder term to either replace an item"
.S HTEXT(3)="or to suppress an item."
D HELP^PXRMEUT(.HTEXT)
Q
;
INQ(DIEN) ;INQ Inquiry/Print option
; Used by 801.41 print templates
; [PXRM REMINDER DIALOG]
; [PXRM DIALOG GROUP]
;
N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
N NLINE,NODE,NSEL,SUB
S NLINE=0,NODE="PXRMDLG4",NSEL=0
K ^TMP(NODE,$J)
;
;Components
W !!," Seq. Dialog",!
D DETAIL^PXRMDLG4(DIEN,"",4,NODE)
;
;Print lines from workfile
S SUB=""
F S SUB=$O(^TMP(NODE,$J,SUB)) Q:'SUB W !,^TMP(NODE,$J,SUB,0)
K ^TMP(NODE,$J)
Q
;
MH(IEN) ;Allow IEN=109 (HX2) as a place holder for 601 entries that do not
;have a corresponding 601.71 entry.
I IEN=109 Q 1
I $G(PXRMINST)=1 Q 1
N MAXNUM
S MAXNUM=+$P($G(^PXRM(800,1,"MH")),U)
I MAXNUM=0 S MAXNUM=25
;DBIA #5056
Q $$ONECR^YTQPXRM5(IEN,MAXNUM)
;
MSEL(NUM) ;
I NUM=4,'$$PATCH^XPDUTL("OR*3.0*243") D EN^DDIOL("THIS SELECTION IS NOT VALID, UNTIL CPRS 27 IS INSTALLED") Q 0
Q 1
;
MHREQHLP ;
N TEXT
S TEXT(1)="Select 0, ""Optional open and optional complete (partial complete possible)"","
S TEXT(2)="if the user should be able to optionally select/open the MH test in the reminder dialog and optionally complete the MH test before the reminder dialog can be finished."
S TEXT(3)=" "
S TEXT(4)="Select 1, ""Required open and required complete before finish"","
S TEXT(5)="if the user is required to select/open and complete the MH test in the reminder dialog before the reminder dialog can be finished."
S TEXT(6)=" "
S TEXT(7)="Select 2, ""Optional open and required complete or cancel before finish"","
S TEXT(8)="if the user should be able to optionally select/open the MH test in the reminder dialog; however, if the user opens the MH test, then the user is required to complete or cancel the MH test before the reminder dialog can be finished."
S TEXT(9)=" "
S TEXT(10)="Note: Clicking the cancel button in the MH Test is considered the same as not opening the MH Test."
S TEXT(11)="Also, Option 2, ""Optional open and required complete or cancel before finish"", only works with CPRS 27 and"
S TEXT(12)="YS_MHA.dll. If Option 2 is selected and the user is using a pre-CPRS 27 version this option will be treated by CPRS as Option 1, ""Required open and required complete before finish""."
D HELP^PXRMEUT(.TEXT)
Q
;
NTERM(DA,OTERM,NTERM) ;
I +OTERM=0 S OTERM=$P($G(DA),U)
I +NTERM=0 K OTERM Q 2
I +OTERM=0,+NTERM>0 K OTERM Q 1
I +OTERM'=+NTERM K OTERM Q 0
K OTERM
Q 1
;
OTERM(DA) ;
K OTERM
S OTERM=$P($G(^PXRMD(801.41,DA,49)),U)
Q
;
RESCHK(IEN) ;Called by input template PXRM EDIT ELEMENT. Preserve Y so template
;branching works.
N CNT,FDA,MSG,RG,RGIEN,VALID,Y
S CNT=0
F S CNT=$O(^PXRMD(801.41,IEN,51,CNT)) Q:CNT'>0 D
.S RGIEN=$P($G(^PXRMD(801.41,IEN,51,CNT,0)),U) I +RGIEN'>0 Q
.S RG=$P($G(^PXRMD(801.41,RGIEN,0)),U,1)
.I RG="" Q
.S VALID=$$RGLSCR(IEN,RG,RGIEN)
.I VALID Q
.W !,"Deleting the result group ",RG," from the element/group."
.S FDA(801.41121,CNT_","_IEN_",",.01)="@"
.D FILE^DIE("E","FDA","MSG")
.S RGKILL=1
.I $D(MSG) D AWRITE^PXRMUTIL("MSG")
Q
;
RSELEDIT(DA) ;
N NODE,RESULT
;RESULT=0 EDIT NOTHING
;RESULT=1 EDIT INFORMATIONAL TEXT
;RESULT=2 EDIT EVERYTHING
S RESULT=2
I $G(PXRMINST)=1,DUZ(0)="@" Q RESULT
S NODE=$G(^PXRMD(801.41,DA,100))
I $P(NODE,U)="N" S RESULT=0
I RESULT=0,+$P(NODE,U,4)=0 S RESULT=1
Q RESULT
;
RGLSCR(DA,X,IEN) ;Input transform/screen for RESULT GROUP LIST
I $G(PXRMINST)=1 Q 1
I $G(PXRMEXCH)=1 Q 1
N HELP,MHTEST,NMATCH,TEXT,VALID,Y
S NMATCH=0
S MHTEST=$O(^PXRMD(801.41,"B",X),-1)
F S MHTEST=$O(^PXRMD(801.41,"B",MHTEST)) Q:(NMATCH>1)!(MHTEST'[X) S NMATCH=NMATCH+1
;If there is an exact match to the user's input turn help on.
S HELP=$S($G(DIQUIET):0,NMATCH=1:1,1:0)
S VALID=1
;Make sure the TYPE is a result group
I '$D(^PXRMD(801.41,"TYPE","S",IEN)) D
. I HELP S TEXT(1)="TYPE must be a result group."
. S VALID=0
;Make sure the finding item for the element matches the
;MH Test assigned to the Result Group
S MHTEST=+$P($G(^PXRMD(801.41,DA,1)),U,5) I MHTEST="" D
. I HELP S TEXT(2)="The MH test is missing."
. S VALID=0
I +$P($G(^PXRMD(801.41,IEN,50)),U)'=MHTEST D
. I HELP S TEXT(3)="The finding item does not match the MH Test assigned to the Result Group"
. S VALID=0
;Make sure a scale has been defined.
I +$P($G(^PXRMD(801.41,IEN,50)),U,2)'>0 D
. I HELP S TEXT(4)="An MH Scale must be defined."
. S VALID=0
;Make sure it is not disabled.
I +$P($G(^PXRMD(801.41,IEN,0)),U,3)>0 D
. S VALID=0
. I HELP D
.. N EM,TYPE
.. S TYPE=$P(^PXRMD(801.41,IEN,0),U,4)
.. S TYPE=$$EXTERNAL^DILFD(801.41,4,"",TYPE,.EM)
.. S TEXT(5)="The "_TYPE_" is disabled."
I HELP,'VALID D EN^DDIOL(.TEXT)
Q VALID
;
SETGBL(FILE) ;
N GBL,LEN
S LEN=$L(FILE)
I $E(FILE,LEN)="," S GBL=U_$E(FILE,1,(LEN-1))_")"
I $E(FILE,LEN)="(" S GBL=U_$E(FILE,1,(LEN-1))
Q GBL
;
TERMS(DA,X) ;
N TERM
S TERM=$P($G(^PXRMD(801.41,DA,49)),U)
I +TERM=0 D Q 0
.W !,"Cannot set Reminder Term Status if the Reminder Term field is blank"
.H 2
I +TERM>0,$G(X)="" Q 2
Q 1
;
TEXT(NLINES,CNT,ATLEN,TEMP,NODE) ;
N CNT1,NOUT,OUTPUT,WIDTH
S WIDTH=IOM-(2+(CNT+ATLEN))
S CNT1=1 D FORMATS^PXRMTEXT(1,WIDTH,TEMP,.NOUT,.OUTPUT)
I NOUT>0 F CNT1=1:1:NOUT D
.S NLINE=NLINE+1,^TMP(NODE,$J,NLINE,0)=$J("",2+(CNT+ATLEN))_OUTPUT(CNT1)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDLG5 8711 printed Apr 09, 2024@20:53:30 Page 2
PXRMDLG5 ;SLC/PJH - Reminder Dialog Edit/Inquiry ;05/02/2017
+1 ;;2.0;CLINICAL REMINDERS;**4,6,12,45**;Feb 04, 2005;Build 566
+2 ;
ALT(DIEN,LEV,DSEQ,NODE,VIEW,NLINE,CNT,ALTLEN) ;
+1 ;Display branching logic text in dialog summary view
+2 NEW ACT,IEN,DNAME,ESTATUS,EVNAME,LINK,NAME,SEQ,STAT,X0
+3 SET SEQ=0
FOR
SET SEQ=$ORDER(^PXRMD(801.41,DIEN,"BL","B",SEQ))
if SEQ'>0
QUIT
Begin DoDot:1
+4 SET IEN=$ORDER(^PXRMD(801.41,DIEN,"BL","B",SEQ,""))
if IEN'>0
QUIT
+5 SET X0=$GET(^PXRMD(801.41,DIEN,"BL",IEN,0))
+6 SET ACT=$SELECT($PIECE(X0,U,4)="H":"Hide if",$PIECE(X0,U,4)="R":"Replaced by",$PIECE(X0,U,4)="C":"Check checkbox for item",$PIECE(X0,U,4)="S":"Suppress checkbox for item",$PIECE(X0,U,4)="L":"Perform Link",1:"")
if ACT=""
QUIT
+7 SET LINK=$SELECT($PIECE(X0,U,4)="L":$PIECE($GET(^PXRMD(801.48,$PIECE(X0,U,7),0)),U),1:"")
+8 SET STAT=$PIECE(X0,U,3)
+9 SET ESTATUS=$SELECT(STAT="D":"Due",STAT="A":"Applicable",STAT="N":"N/A",STAT="F":"False",STAT="T":"True",1:"")
+10 SET DNAME=""
IF $PIECE(X0,U,5)>0
SET DNAME=$PIECE($GET(^PXRMD(801.41,$PIECE(X0,U,5),0)),U)
+11 IF $PIECE(X0,U,4)="C"!($PIECE(X0,U,4)="S")
SET DNAME=$PIECE(^PXRMD(801.41,DIEN,0),U)
+12 SET IEN=+$PIECE(X0,U,2)
+13 IF $PIECE(X0,U,2)["811.9"
SET NAME=$PIECE($GET(^PXD(811.9,IEN,0)),U)
if NAME=""
QUIT
SET EVNAME="Reminder Definition "_NAME
+14 IF $PIECE(X0,U,2)["811.5"
SET NAME=$PIECE($GET(^PXRMD(811.5,IEN,0)),U)
if NAME=""
QUIT
SET EVNAME="Reminder Term "_NAME
+15 SET TEMP="Sequence "_SEQ_" "_ACT_$SELECT(DNAME'="":" "_DNAME_" if ",LINK'="":" "_LINK_" if ",1:" ")_EVNAME_" evaluates as "_ESTATUS
+16 DO TEXT(.NLINES,CNT,ALTLEN,TEMP,NODE)
End DoDot:1
+17 QUIT
+18 ;
ASK(YESNO,PIEN) ;Confirm
+1 KILL DIR,DIROUT,DIRUT,DNAME,DTOUT,DTYP,DUOUT,TEXT,X,Y
+2 NEW DDATA,DNAME,DTYP
+3 SET DDATA=$GET(^PXRMD(801.41,PIEN,0))
+4 ;Parent name and type
+5 SET DNAME=$PIECE(DDATA,U)
SET DTYP=$PIECE(DDATA,U,4)
+6 ;
+7 SET DIR(0)="YA0"
+8 SET DIR("A")="Add sequence "_SEQ_" to "
+9 IF DTYP="G"
SET DIR("A")=DIR("A")_"group "_DNAME_": "
+10 IF '$TEST
SET DIR("A")=DIR("A")_"reminder dialog ?: "
+11 SET DIR("B")="N"
SET DIR("?")="Enter Y or N. For detailed help type ??"
+12 SET DIR("??")=U_"D XHLP^PXRMDLG(1)"
+13 DO ^DIR
KILL DIR
+14 IF $DATA(DIROUT)
SET DTOUT=1
+15 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+16 SET YESNO=$EXTRACT(Y(0))
IF YESNO'="Y"
SET DUOUT=1
+17 SET VALMBCK="R"
+18 QUIT
+19 ;
BHELP(VALUE) ;
+1 NEW HTEXT
+2 DO FULL^VALM1
+3 ;Help text for Reminder Dialog Branching logic
+4 IF VALUE=1
Begin DoDot:1
+5 ;Reminder Term field
+6 SET HTEXT(1)="Enter a reminder term that will be used to determine if the reminder"
+7 SET HTEXT(2)="element/group should be replaced or suppressed if the reminder term evaluation"
+8 SET HTEXT(3)="matches the value in the Reminder Term Status field."
End DoDot:1
+9 IF VALUE=2
Begin DoDot:1
+10 ;Reminder Term Status field
+11 SET HTEXT(1)="Enter either 1 for true or 0 for false. This value will be used with the"
+12 SET HTEXT(2)="reminder term field to determine if this item should be replaced with a"
+13 SET HTEXT(3)="different element/group defined in the Replacement Element/Group field, or if"
+14 SET HTEXT(4)="this item should be suppressed."
End DoDot:1
+15 IF VALUE=3
Begin DoDot:1
+16 ;Replacement Element/Group field
+17 SET HTEXT(1)="Enter an element/group that will be used as a replacement to thisitem, or"
+18 SET HTEXT(2)="leave this field blank to suppress this item if the term evaluation"
+19 SET HTEXT(3)="matches the value defined in the term status field. "
End DoDot:1
+20 IF VALUE=4
Begin DoDot:1
+21 ;Patient Specific field
+22 SET HTEXT(1)="Enter either 1 for true or 0 for false. This value must be set to true"
+23 SET HTEXT(2)="if item in this dialog will be using reminder term to either replace an item"
+24 SET HTEXT(3)="or to suppress an item."
End DoDot:1
+25 DO HELP^PXRMEUT(.HTEXT)
+26 QUIT
+27 ;
INQ(DIEN) ;INQ Inquiry/Print option
+1 ; Used by 801.41 print templates
+2 ; [PXRM REMINDER DIALOG]
+3 ; [PXRM DIALOG GROUP]
+4 ;
+5 NEW DEF,DEF1,DEF2
DO DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
+6 NEW NLINE,NODE,NSEL,SUB
+7 SET NLINE=0
SET NODE="PXRMDLG4"
SET NSEL=0
+8 KILL ^TMP(NODE,$JOB)
+9 ;
+10 ;Components
+11 WRITE !!," Seq. Dialog",!
+12 DO DETAIL^PXRMDLG4(DIEN,"",4,NODE)
+13 ;
+14 ;Print lines from workfile
+15 SET SUB=""
+16 FOR
SET SUB=$ORDER(^TMP(NODE,$JOB,SUB))
if 'SUB
QUIT
WRITE !,^TMP(NODE,$JOB,SUB,0)
+17 KILL ^TMP(NODE,$JOB)
+18 QUIT
+19 ;
MH(IEN) ;Allow IEN=109 (HX2) as a place holder for 601 entries that do not
+1 ;have a corresponding 601.71 entry.
+2 IF IEN=109
QUIT 1
+3 IF $GET(PXRMINST)=1
QUIT 1
+4 NEW MAXNUM
+5 SET MAXNUM=+$PIECE($GET(^PXRM(800,1,"MH")),U)
+6 IF MAXNUM=0
SET MAXNUM=25
+7 ;DBIA #5056
+8 QUIT $$ONECR^YTQPXRM5(IEN,MAXNUM)
+9 ;
MSEL(NUM) ;
+1 IF NUM=4
IF '$$PATCH^XPDUTL("OR*3.0*243")
DO EN^DDIOL("THIS SELECTION IS NOT VALID, UNTIL CPRS 27 IS INSTALLED")
QUIT 0
+2 QUIT 1
+3 ;
MHREQHLP ;
+1 NEW TEXT
+2 SET TEXT(1)="Select 0, ""Optional open and optional complete (partial complete possible)"","
+3 SET TEXT(2)="if the user should be able to optionally select/open the MH test in the reminder dialog and optionally complete the MH test before the reminder dialog can be finished."
+4 SET TEXT(3)=" "
+5 SET TEXT(4)="Select 1, ""Required open and required complete before finish"","
+6 SET TEXT(5)="if the user is required to select/open and complete the MH test in the reminder dialog before the reminder dialog can be finished."
+7 SET TEXT(6)=" "
+8 SET TEXT(7)="Select 2, ""Optional open and required complete or cancel before finish"","
+9 SET TEXT(8)="if the user should be able to optionally select/open the MH test in the reminder dialog; however, if the user opens the MH test, then the user is required to complete or cancel the MH test before the reminder dialog can be finished
."
+10 SET TEXT(9)=" "
+11 SET TEXT(10)="Note: Clicking the cancel button in the MH Test is considered the same as not opening the MH Test."
+12 SET TEXT(11)="Also, Option 2, ""Optional open and required complete or cancel before finish"", only works with CPRS 27 and"
+13 SET TEXT(12)="YS_MHA.dll. If Option 2 is selected and the user is using a pre-CPRS 27 version this option will be treated by CPRS as Option 1, ""Required open and required complete before finish""."
+14 DO HELP^PXRMEUT(.TEXT)
+15 QUIT
+16 ;
NTERM(DA,OTERM,NTERM) ;
+1 IF +OTERM=0
SET OTERM=$PIECE($GET(DA),U)
+2 IF +NTERM=0
KILL OTERM
QUIT 2
+3 IF +OTERM=0
IF +NTERM>0
KILL OTERM
QUIT 1
+4 IF +OTERM'=+NTERM
KILL OTERM
QUIT 0
+5 KILL OTERM
+6 QUIT 1
+7 ;
OTERM(DA) ;
+1 KILL OTERM
+2 SET OTERM=$PIECE($GET(^PXRMD(801.41,DA,49)),U)
+3 QUIT
+4 ;
RESCHK(IEN) ;Called by input template PXRM EDIT ELEMENT. Preserve Y so template
+1 ;branching works.
+2 NEW CNT,FDA,MSG,RG,RGIEN,VALID,Y
+3 SET CNT=0
+4 FOR
SET CNT=$ORDER(^PXRMD(801.41,IEN,51,CNT))
if CNT'>0
QUIT
Begin DoDot:1
+5 SET RGIEN=$PIECE($GET(^PXRMD(801.41,IEN,51,CNT,0)),U)
IF +RGIEN'>0
QUIT
+6 SET RG=$PIECE($GET(^PXRMD(801.41,RGIEN,0)),U,1)
+7 IF RG=""
QUIT
+8 SET VALID=$$RGLSCR(IEN,RG,RGIEN)
+9 IF VALID
QUIT
+10 WRITE !,"Deleting the result group ",RG," from the element/group."
+11 SET FDA(801.41121,CNT_","_IEN_",",.01)="@"
+12 DO FILE^DIE("E","FDA","MSG")
+13 SET RGKILL=1
+14 IF $DATA(MSG)
DO AWRITE^PXRMUTIL("MSG")
End DoDot:1
+15 QUIT
+16 ;
RSELEDIT(DA) ;
+1 NEW NODE,RESULT
+2 ;RESULT=0 EDIT NOTHING
+3 ;RESULT=1 EDIT INFORMATIONAL TEXT
+4 ;RESULT=2 EDIT EVERYTHING
+5 SET RESULT=2
+6 IF $GET(PXRMINST)=1
IF DUZ(0)="@"
QUIT RESULT
+7 SET NODE=$GET(^PXRMD(801.41,DA,100))
+8 IF $PIECE(NODE,U)="N"
SET RESULT=0
+9 IF RESULT=0
IF +$PIECE(NODE,U,4)=0
SET RESULT=1
+10 QUIT RESULT
+11 ;
RGLSCR(DA,X,IEN) ;Input transform/screen for RESULT GROUP LIST
+1 IF $GET(PXRMINST)=1
QUIT 1
+2 IF $GET(PXRMEXCH)=1
QUIT 1
+3 NEW HELP,MHTEST,NMATCH,TEXT,VALID,Y
+4 SET NMATCH=0
+5 SET MHTEST=$ORDER(^PXRMD(801.41,"B",X),-1)
+6 FOR
SET MHTEST=$ORDER(^PXRMD(801.41,"B",MHTEST))
if (NMATCH>1)!(MHTEST'[X)
QUIT
SET NMATCH=NMATCH+1
+7 ;If there is an exact match to the user's input turn help on.
+8 SET HELP=$SELECT($GET(DIQUIET):0,NMATCH=1:1,1:0)
+9 SET VALID=1
+10 ;Make sure the TYPE is a result group
+11 IF '$DATA(^PXRMD(801.41,"TYPE","S",IEN))
Begin DoDot:1
+12 IF HELP
SET TEXT(1)="TYPE must be a result group."
+13 SET VALID=0
End DoDot:1
+14 ;Make sure the finding item for the element matches the
+15 ;MH Test assigned to the Result Group
+16 SET MHTEST=+$PIECE($GET(^PXRMD(801.41,DA,1)),U,5)
IF MHTEST=""
Begin DoDot:1
+17 IF HELP
SET TEXT(2)="The MH test is missing."
+18 SET VALID=0
End DoDot:1
+19 IF +$PIECE($GET(^PXRMD(801.41,IEN,50)),U)'=MHTEST
Begin DoDot:1
+20 IF HELP
SET TEXT(3)="The finding item does not match the MH Test assigned to the Result Group"
+21 SET VALID=0
End DoDot:1
+22 ;Make sure a scale has been defined.
+23 IF +$PIECE($GET(^PXRMD(801.41,IEN,50)),U,2)'>0
Begin DoDot:1
+24 IF HELP
SET TEXT(4)="An MH Scale must be defined."
+25 SET VALID=0
End DoDot:1
+26 ;Make sure it is not disabled.
+27 IF +$PIECE($GET(^PXRMD(801.41,IEN,0)),U,3)>0
Begin DoDot:1
+28 SET VALID=0
+29 IF HELP
Begin DoDot:2
+30 NEW EM,TYPE
+31 SET TYPE=$PIECE(^PXRMD(801.41,IEN,0),U,4)
+32 SET TYPE=$$EXTERNAL^DILFD(801.41,4,"",TYPE,.EM)
+33 SET TEXT(5)="The "_TYPE_" is disabled."
End DoDot:2
End DoDot:1
+34 IF HELP
IF 'VALID
DO EN^DDIOL(.TEXT)
+35 QUIT VALID
+36 ;
SETGBL(FILE) ;
+1 NEW GBL,LEN
+2 SET LEN=$LENGTH(FILE)
+3 IF $EXTRACT(FILE,LEN)=","
SET GBL=U_$EXTRACT(FILE,1,(LEN-1))_")"
+4 IF $EXTRACT(FILE,LEN)="("
SET GBL=U_$EXTRACT(FILE,1,(LEN-1))
+5 QUIT GBL
+6 ;
TERMS(DA,X) ;
+1 NEW TERM
+2 SET TERM=$PIECE($GET(^PXRMD(801.41,DA,49)),U)
+3 IF +TERM=0
Begin DoDot:1
+4 WRITE !,"Cannot set Reminder Term Status if the Reminder Term field is blank"
+5 HANG 2
End DoDot:1
QUIT 0
+6 IF +TERM>0
IF $GET(X)=""
QUIT 2
+7 QUIT 1
+8 ;
TEXT(NLINES,CNT,ATLEN,TEMP,NODE) ;
+1 NEW CNT1,NOUT,OUTPUT,WIDTH
+2 SET WIDTH=IOM-(2+(CNT+ATLEN))
+3 SET CNT1=1
DO FORMATS^PXRMTEXT(1,WIDTH,TEMP,.NOUT,.OUTPUT)
+4 IF NOUT>0
FOR CNT1=1:1:NOUT
Begin DoDot:1
+5 SET NLINE=NLINE+1
SET ^TMP(NODE,$JOB,NLINE,0)=$JUSTIFY("",2+(CNT+ATLEN))_OUTPUT(CNT1)
End DoDot:1
+6 QUIT
+7 ;
