Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PXRMDLG5

PXRMDLG5.m

Go to the documentation of this file. 
  1. PXRMDLG5 ; SLC/PJH - Reminder Dialog Edit/Inquiry ;06/08/2009
  1.  ;;2.0;CLINICAL REMINDERS;**4,6,12**;Feb 04, 2005;Build 73
  1.  ;
  1. ALT(DIEN,LEV,DSEQ,NODE,VIEW,NLINE,CNT,ALTLEN) ;
  1.  ;Display branching logic text in dialog summary view
  1.  N DATA,DNAM,DTYP,IEN,TERM,TNAME,TSTAT,TEMP
  1.  S DATA=$G(^PXRMD(801.41,DIEN,49))
  1.  I '+$P(DATA,U)!($P($G(DATA),U,2)="") Q
  1.  S TNAME=$P($G(^PXRMD(811.5,$P(DATA,U),0)),U)
  1.  S TSTAT=$S($P(DATA,U,2)="1":"TRUE",1:"FALSE")
  1.  I +$P(DATA,U,3)>0 D
  1.  .S IEN=$P(DATA,U,3),DNAM=$P($G(^PXRMD(801.41,IEN,0)),U)
  1.  .S DTYP=$S($P($G(^PXRMD(801.41,IEN,0)),U,4)="E":"Element",$P($G(^PXRMD(801.41,IEN,0)),U,4)="G":"Group")
  1.  I $G(DNAM)="" S TEMP="Suppressed if Reminder Term "_TNAME_" evaluates as "_TSTAT
  1.  I $G(DNAM)'="" S TEMP="Replaced by "_DNAM_" if Reminder Term "_TNAME_" evaluates as "_TSTAT
  1.  D TEXT(.NLINES,CNT,ALTLEN,TEMP,NODE)
  1.  Q
  1.  ;
  1. ASK(YESNO,PIEN) ;Confirm
  1.  K DIR,DIROUT,DIRUT,DNAME,DTOUT,DTYP,DUOUT,TEXT,X,Y
  1.  N DDATA,DNAME,DTYP
  1.  S DDATA=$G(^PXRMD(801.41,PIEN,0))
  1.  ;Parent name and type
  1.  S DNAME=$P(DDATA,U),DTYP=$P(DDATA,U,4)
  1.  ;
  1.  S DIR(0)="YA0"
  1.  S DIR("A")="Add sequence "_SEQ_" to "
  1.  I DTYP="G" S DIR("A")=DIR("A")_"group "_DNAME_": "
  1.  E  S DIR("A")=DIR("A")_"reminder dialog ?: "
  1.  S DIR("B")="N",DIR("?")="Enter Y or N. For detailed help type ??"
  1.  S DIR("??")=U_"D XHLP^PXRMDLG(1)"
  1.  D ^DIR K DIR
  1.  I $D(DIROUT) S DTOUT=1
  1.  I $D(DTOUT)!($D(DUOUT)) Q
  1.  S YESNO=$E(Y(0)) I YESNO'="Y" S DUOUT=1
  1.  S VALMBCK="R"
  1.  Q
  1.  ;
  1. BHELP(VALUE) ;
  1.  N HTEXT
  1.  D FULL^VALM1
  1.  ;Help text for Reminder Dialog Branching logic
  1.  I VALUE=1 D
  1.  .;Reminder Term field
  1.  .S HTEXT(1)="Enter a reminder term that will be used to determine if the reminder"
  1.  .S HTEXT(2)="element/group should be replaced or suppressed if the reminder term evaluation"
  1.  .S HTEXT(3)="matches the value in the Reminder Term Status field."
  1.  I VALUE=2 D
  1.  .;Reminder Term Status field
  1.  .S HTEXT(1)="Enter either 1 for true or 0 for false. This value will be used with the"
  1.  .S HTEXT(2)="reminder term field to determine if this item should be replaced with a"
  1.  .S HTEXT(3)="different element/group defined in the Replacement Element/Group field, or if"
  1.  .S HTEXT(4)="this item should be suppressed."
  1.  I VALUE=3 D
  1.  .;Replacement Element/Group field
  1.  .S HTEXT(1)="Enter an element/group that will be used as a replacement to thisitem, or"
  1.  .S HTEXT(2)="leave this field blank to suppress this item if the term evaluation"
  1.  .S HTEXT(3)="matches the value defined in the term status field. "
  1.  I VALUE=4 D
  1.  .;Patient Specific field
  1.  .S HTEXT(1)="Enter either 1 for true or 0 for false. This value must be set to true"
  1.  .S HTEXT(2)="if item in this dialog will be using reminder term to either replace an item"
  1.  .S HTEXT(3)="or to suppress an item."
  1.  D HELP^PXRMEUT(.HTEXT)
  1.  Q
  1.  ;
  1. INQ(DIEN) ;INQ Inquiry/Print option
  1.  ; Used by 801.41 print templates
  1.  ; [PXRM REMINDER DIALOG]
  1.  ; [PXRM DIALOG GROUP]
  1.  ;
  1.  N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
  1.  N NLINE,NODE,NSEL,SUB
  1.  S NLINE=0,NODE="PXRMDLG4",NSEL=0
  1.  K ^TMP(NODE,$J)
  1.  ;
  1.  ;Components
  1.  W !!,"      Seq.       Dialog",!
  1.  D DETAIL^PXRMDLG4(DIEN,"",4,NODE)
  1.  ;
  1.  ;Print lines from workfile
  1.  S SUB=""
  1.  F  S SUB=$O(^TMP(NODE,$J,SUB)) Q:'SUB  W !,^TMP(NODE,$J,SUB,0)
  1.  K ^TMP(NODE,$J)
  1.  Q
  1.  ;
  1. MH(IEN) ;Allow IEN=109 (HX2) as a place holder for 601 entries that do not
  1.  ;have a corresponding 601.71 entry.
  1.  I IEN=109 Q 1
  1.  I $G(PXRMINST)=1 Q 1
  1.  N MAXNUM
  1.  S MAXNUM=+$P($G(^PXRM(800,1,"MH")),U)
  1.  I MAXNUM=0 S MAXNUM=25
  1.  ;DBIA #5056
  1.  Q $$ONECR^YTQPXRM5(IEN,MAXNUM)
  1.  ;
  1. MSEL(NUM) ;
  1.  I NUM=4,'$$PATCH^XPDUTL("OR*3.0*243") D EN^DDIOL("THIS SELECTION IS NOT VALID, UNTIL CPRS 27 IS INSTALLED") Q 0
  1.  Q 1
  1.  ;
  1. MHREQHLP ;
  1.  N TEXT
  1.  S TEXT(1)="Select 0, ""Optional open and optional complete (partial complete possible)"","
  1.  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."
  1.  S TEXT(3)=" "
  1.  S TEXT(4)="Select 1, ""Required open and required complete before finish"","
  1.  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."
  1.  S TEXT(6)=" "
  1.  S TEXT(7)="Select 2, ""Optional open and required complete or cancel before finish"","
  1.  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."
  1.  S TEXT(9)=" "
  1.  S TEXT(10)="Note: Clicking the cancel button in the MH Test is considered the same as not opening the MH Test."
  1.  S TEXT(11)="Also, Option 2, ""Optional open and required complete or cancel before finish"", only works with CPRS 27 and"
  1.  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""."
  1.  D HELP^PXRMEUT(.TEXT)
  1.  Q
  1.  ;
  1. NTERM(DA,OTERM,NTERM) ;
  1.  I +OTERM=0 S OTERM=$P($G(DA),U)
  1.  I +NTERM=0 K OTERM Q 2
  1.  I +OTERM=0,+NTERM>0 K OTERM Q 1
  1.  I +OTERM'=+NTERM K OTERM Q 0
  1.  K OTERM
  1.  Q 1
  1.  ;
  1. OTERM(DA) ;
  1.  K OTERM
  1.  S OTERM=$P($G(^PXRMD(801.41,DA,49)),U)
  1.  Q
  1.  ;
  1. RESCHK(IEN) ;Called by input template PXRM EDIT ELEMENT. Preserve Y so template
  1.  ;branching works.
  1.  N CNT,FDA,MSG,RG,RGIEN,VALID,Y
  1.  S CNT=0
  1.  F  S CNT=$O(^PXRMD(801.41,IEN,51,CNT)) Q:CNT'>0  D
  1.  .S RGIEN=$P($G(^PXRMD(801.41,IEN,51,CNT,0)),U) I +RGIEN'>0 Q
  1.  .S RG=$P($G(^PXRMD(801.41,RGIEN,0)),U,1)
  1.  .I RG="" Q
  1.  .S VALID=$$RGLSCR(IEN,RG,RGIEN)
  1.  .I VALID Q
  1.  .W !,"Deleting the result group ",RG," from the element/group."
  1.  .S FDA(801.41121,CNT_","_IEN_",",.01)="@"
  1.  .D FILE^DIE("E","FDA","MSG")
  1.  .S RGKILL=1
  1.  .I $D(MSG) D AWRITE^PXRMUTIL("MSG")
  1.  Q
  1.  ;
  1. RSELEDIT(DA) ;
  1.  N NODE,RESULT
  1.  ;RESULT=0 EDIT NOTHING
  1.  ;RESULT=1 EDIT INFORMATIONAL TEXT
  1.  ;RESULT=2 EDIT EVERYTHING
  1.  S RESULT=2
  1.  I $G(PXRMINST)=1,DUZ(0)="@" Q RESULT
  1.  S NODE=$G(^PXRMD(801.41,DA,100))
  1.  I $P(NODE,U)="N" S RESULT=0
  1.  I RESULT=0,+$P(NODE,U,4)=0 S RESULT=1
  1.  Q RESULT
  1.  ;
  1. RGLSCR(DA,X,IEN) ;Input transform/screen for RESULT GROUP LIST
  1.  I $G(PXRMINST)=1 Q 1
  1.  I $G(PXRMEXCH)=1 Q 1
  1.  N HELP,MHTEST,NMATCH,TEXT,VALID,Y
  1.  S NMATCH=0
  1.  S MHTEST=$O(^PXRMD(801.41,"B",X),-1)
  1.  F  S MHTEST=$O(^PXRMD(801.41,"B",MHTEST)) Q:(NMATCH>1)!(MHTEST'[X)  S NMATCH=NMATCH+1
  1.  ;If there is an exact match to the user's input turn help on.
  1.  S HELP=$S($G(DIQUIET):0,NMATCH=1:1,1:0)
  1.  S VALID=1
  1.  ;Make sure the TYPE is a result group
  1.  I '$D(^PXRMD(801.41,"TYPE","S",IEN)) D
  1.  . I HELP S TEXT(1)="TYPE must be a result group."
  1.  . S VALID=0
  1.  ;Make sure the finding item for the element matches the 
  1.  ;MH Test assigned to the Result Group
  1.  S MHTEST=+$P($G(^PXRMD(801.41,DA,1)),U,5) I MHTEST="" D
  1.  . I HELP S TEXT(2)="The MH test is missing."
  1.  . S VALID=0
  1.  I +$P($G(^PXRMD(801.41,IEN,50)),U)'=MHTEST D
  1.  . I HELP S TEXT(3)="The finding item does not match the MH Test assigned to the Result Group"
  1.  . S VALID=0
  1.  ;Make sure a scale has been defined.
  1.  I +$P($G(^PXRMD(801.41,IEN,50)),U,2)'>0 D
  1.  . I HELP S TEXT(4)="An MH Scale must be defined."
  1.  . S VALID=0
  1.  ;Make sure it is not disabled.
  1.  I +$P($G(^PXRMD(801.41,IEN,0)),U,3)>0 D
  1.  . S VALID=0
  1.  . I HELP D
  1.  .. N EM,TYPE
  1.  .. S TYPE=$P(^PXRMD(801.41,IEN,0),U,4)
  1.  .. S TYPE=$$EXTERNAL^DILFD(801.41,4,"",TYPE,.EM)
  1.  .. S TEXT(5)="The "_TYPE_" is disabled."
  1.  I HELP,'VALID D EN^DDIOL(.TEXT)
  1.  Q VALID
  1.  ;
  1. SETGBL(FILE) ;
  1.  N GBL,LEN
  1.  S LEN=$L(FILE)
  1.  I $E(FILE,LEN)="," S GBL=U_$E(FILE,1,(LEN-1))_")"
  1.  I $E(FILE,LEN)="(" S GBL=U_$E(FILE,1,(LEN-1))
  1.  Q GBL
  1.  ;
  1. TERMS(DA,X) ;
  1.  N TERM
  1.  S TERM=$P($G(^PXRMD(801.41,DA,49)),U)
  1.  I +TERM=0 D  Q 0
  1.  .W !,"Cannot set Reminder Term Status if the Reminder Term field is blank"
  1.  .H 2
  1.  I +TERM>0,$G(X)="" Q 2
  1.  Q 1
  1.  ;
  1. TEXT(NLINES,CNT,ATLEN,TEMP,NODE) ;
  1.  N CNT1,NOUT,OUTPUT,WIDTH
  1.  S WIDTH=IOM-(2+(CNT+ATLEN))
  1.  S CNT1=1 D FORMATS^PXRMTEXT(1,WIDTH,TEMP,.NOUT,.OUTPUT)
  1.  I NOUT>0 F CNT1=1:1:NOUT D
  1.  .S NLINE=NLINE+1,^TMP(NODE,$J,NLINE,0)=$J("",2+(CNT+ATLEN))_OUTPUT(CNT1)
  1.  Q
  1.  ;