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

PXRMDBLD.m

Go to the documentation of this file. 
  1. PXRMDBLD ; SLC/PJH - Reminder Dialog Generation. ;05/13/2009
  1.  ;;2.0;CLINICAL REMINDERS;**12**;Feb 04, 2005;Build 73
  1.  ;
  1.  ;Called from PXRMGEDT
  1.  ;
  1. START ;
  1.  N ANS,DIC,DNAME,LIT,LIT1,MSG,NAME,REDO,REM,RLNK,RNAME,ORY
  1.  N PXRMENAB,PXRMLINK,PXRMREPL,PXRMREM
  1.  ;Prompt for auto or manual addition
  1.  S ANS="" D ASK(.ANS) Q:$D(DUOUT)!$D(DTOUT)
  1.  ;Auto
  1.  I ANS="Y" D AUTO Q
  1.  ;Manual
  1.  I ANS'="Y" D ADD^PXRMDEDT
  1. END Q
  1.  ;
  1.  ;Called by protocol PXRM DIALOG ADD
  1.  ;----------------------------------
  1. ADD(PXRMITEM) ;
  1.  N ANS,DNAME,DTOUT,DUOUT
  1.  S VALMBCK="R"
  1.  W IORESET
  1.  W !,PXRMHD
  1.  S DNAME=""
  1.  D ASK^PXRMDBLD(.ANS) Q:$D(DTOUT)!$D(DUOUT)
  1.  I ANS="Y" D AUTOP(PXRMITEM)
  1.  Q
  1.  ;
  1.  ;Ask autogenerate/manual
  1.  ;-----------------------
  1. ASK(YESNO) ;
  1.  N X,Y,TEXT,DIR
  1.  K DIROUT,DIRUT,DTOUT,DUOUT
  1.  S DIR(0)="YA0"
  1.  S DIR("A")="GENERATE DIALOG AUTOMATICALLY: "
  1.  S DIR("B")="N"
  1.  S DIR("?")="Enter Y or N. For detailed help type ??"
  1.  S DIR("??")=U_"D HELP^PXRMDBLD(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))
  1.  Q
  1.  ;
  1.  ;Source reminder for auto-generate
  1.  ;---------------------------------
  1. AUTO S DIC("A")="SELECT REMINDER TO GENERATE DIALOG FROM: "
  1.  S LIT1="You must select a reminder!"
  1.  D SEL(811.9,"AEQMZ",.PXRMREM)
  1.  Q:$D(DTOUT)!$D(DUOUT)
  1.  S REM=$P(PXRMREM(1),U),DNAME=""
  1.  ;Display related dialogs
  1.  D DISP(REM)
  1.  ;Promt for type of generate
  1.  D AUTOP(REM)
  1.  Q
  1.  ;
  1.  ;Autogenerate prompts
  1.  ;--------------------
  1. AUTOP(REM) ;
  1.  S RNAME=$P($G(^PXD(811.9,REM,0)),U)
  1.  F  D  Q:$D(DUOUT)!$D(DTOUT)!(DNAME]"")
  1.  .N CONFIRM,X,Y,DIR,DA
  1.  .K DIROUT,DIRUT,DTOUT,DUOUT
  1.  .S DIR(0)="F"_U_"3:40"_U_"K:(X?.N)!'(X'?1P.E) X"
  1.  .S DIR("A")="ENTER A UNIQUE DIALOG NAME"
  1.  .S DIR("B")=RNAME
  1.  .S DIR("?")="Select a unique name for the generated dialog."
  1.  .S DIR("??")=U_"D HELP^PXRMDBLD(6)"
  1.  .D ^DIR K DIR
  1.  .I $D(DIROUT) S DTOUT=1
  1.  .I $D(DTOUT)!($D(DUOUT)) Q
  1.  .I Y["""" D EN^DDIOL(" name cannot contain quotes!") Q
  1.  .I $D(^PXRMD(801.41,"B",Y)) D  Q:$G(DTOUT)=1
  1.  ..D CONFIRM(.CONFIRM,Y) I CONFIRM="Y" D  Q:$G(DTOUT)=1
  1.  ...S DA=$O(^PXRMD(801.41,"B",Y,""))
  1.  ...I $P($G(^PXRMD(801.41,DA,0)),U,3)="" D  Q:$G(DTOUT)=1
  1.  ....W !!,"THE CURRENT DIALOG IS ENABLED PLEASE DISABLE IT BEFORE "
  1.  ....W "CONTINING." H 2 S DTOUT=1 Q
  1.  ..I '$$OVER(Y) S DTOUT=1 Q
  1.  ..S Y=$$NAME^PXRMDCPY(DA,Y)
  1.  ..;If this is the linked reminder clear it
  1.  ..I $P($G(^PXD(811.9,REM,51)),U)=$G(DA) S $P(^PXD(811.9,REM,51),U)=""
  1.  .;Option to LINK DIALOG to REMINDER if reminder is not linked already
  1.  .S RLNK=$P($G(^PXD(811.9,REM,51)),U),PXRMLINK=0
  1.  .I 'RLNK D LINK(.PXRMLINK) Q:$D(DTOUT)!$D(DUOUT) 
  1.  .;Option to enable dialog
  1.  .D ENABLE(.PXRMENAB) Q:$D(DTOUT)!$D(DUOUT) 
  1.  .;Option to replace existing dialog elements
  1.  .D REPL(.PXRMREPL) Q:$D(DTOUT)!$D(DUOUT) 
  1.  .;Use name entered
  1.  .S DNAME=Y
  1.  ;
  1.  Q:$D(DUOUT)!$D(DTOUT)
  1.  ;Build dialog
  1.  N CHECK D BUILD^PXRMDBL1(REM,DNAME,.CHECK)
  1.  D FINDCHCK(DNAME)
  1.  Q
  1.  ;
  1.  ;Display dialogs autogenerated from this reminder
  1.  ;------------------------------------------------
  1. DISP(RIEN) ;
  1.  N ARRAY,DSUB,FIRST
  1.  ;Get Autogenerated dialogs
  1.  S FIRST=1,DSUB=""
  1.  F  S DSUB=$O(^PXRMD(801.41,"AG",RIEN,DSUB)) Q:'DSUB  D
  1.  .I FIRST W !!,"Associated Dialogs:" S FIRST=0
  1.  .W ?25,$P($G(^PXRMD(801.41,DSUB,0)),U),!
  1.  Q
  1.  ;
  1.  ;Disable generated dialog 
  1.  ;------------------------
  1. ENABLE(YESNO) ;
  1.  N X,Y,TEXT,DIR
  1.  K DIROUT,DIRUT,DTOUT,DUOUT
  1.  S DIR(0)="YA0"
  1.  S DIR("A")="ENABLE DIALOG: "
  1.  S DIR("B")="NO"
  1.  S DIR("?")="Enter Y or N. For detailed help type ??"
  1.  S DIR("??")=U_"D HELP^PXRMDBLD(4)"
  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))
  1.  Q
  1.  ;
  1. FINDCHCK(DNAME) ;
  1.  W !!,"Scanning dialog "_DNAME_" for inactived findings."
  1.  N CNT,DIALIEN,DIEN,DLGARR,ERRCNT,ERRMSG,FAIL,NAME,STDFILES
  1.  N STRTEXT,TEXT,TYPE,WRITMSG
  1.  ;
  1.  S WRITMSG=0
  1.  D DIALDSAR^PXRMFRPT(.STDFILES) I '$D(STDFILES) Q
  1.  S DIALIEN=$O(^PXRMD(801.41,"B",DNAME,"")) Q:DIALIEN'>0
  1.  S ERRCNT=0,CNT=0,FAIL=0
  1.  S STRTEXT(1)="Dialog "_DNAME_" contains errors. Review the dialog before using it in CPRS."
  1.  D BUILDMSG^PXRMDLRP(.STRTEXT,.CNT,.TEXT)
  1.  ;
  1.  ;build array of dialog items
  1.  D DITEMAR^PXRMDLRP(DIALIEN,.DLGARR,.ERRCNT,.ERRMSG,.FAIL)
  1.  ;
  1.  ;bad data format in the dialog
  1.  I FAIL="F" D  Q
  1.  .D BUILDMSG^PXRMDLRP(.ERRMSG,.CNT,.TEXT)
  1.  .D EN^DDIOL(.TEXT)
  1.  .H 2
  1.  ;
  1.  ;scan for inactive finding items, checks against standardized files
  1.  S DIEN=0 F  S DIEN=$O(DLGARR(DIEN)) Q:DIEN'>0  D
  1.  .K ERRMSG
  1.  .I $$DISABCHK^PXRMDLG6(DIEN,.STDFILES,.ERRMSG)=1 Q
  1.  .;
  1.  .S NAME=$P($G(^PXRMD(801.41,DIEN,0)),U)
  1.  .S TYPE=$$EXTERNAL^DILFD(801.41,4,"",$P($G(^PXRMD(801.41,DIEN,0)),U,4))
  1.  .S $P(^PXRMD(801.41,DIEN,0),U,3)=1
  1.  .S STRTEXT(1)="Dialog "_TYPE_" "_NAME_" has been marked disable for the following reason(s)."
  1.  .D BUILDMSG^PXRMDLRP(.STRTEXT,.CNT,.TEXT)
  1.  .D BUILDMSG^PXRMDLRP(.ERRMSG,.CNT,.TEXT)
  1.  .S WRITMSG=1
  1.  ;
  1.  I WRITMSG=1 D EN^DDIOL(.TEXT) H 2
  1.  Q
  1.  ;Link dialog to reminder 
  1.  ;-----------------------
  1.  N X,Y,TEXT,DIR
  1.  K DIROUT,DIRUT,DTOUT,DUOUT
  1.  S DIR(0)="YA0"
  1.  S DIR("A")="LINK DIALOG TO REMINDER: "
  1.  S DIR("B")="YES"
  1.  S DIR("?")="Enter Y or N. For detailed help type ??"
  1.  S DIR("??")=U_"D HELP^PXRMDBLD(5)"
  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))
  1.  Q
  1.  ;
  1.  ;Option to override existing dialog
  1.  ;----------------------------------
  1. OVER(DNAME) ;
  1.  N DIR,X,Y
  1.  S DIR(0)="Y",DIR("B")="NO"
  1.  S DIR("A")="OVERWRITE EXISTING REMINDER DIALOG "
  1.  S DIR("?")="Enter Y or N. For detailed help type ??"
  1.  S DIR("??")=U_"D HELP^PXRMDBLD(2)"
  1.  D ^DIR K DIR
  1.  I $D(DIROUT) S DTOUT=1
  1.  I $D(DTOUT)!($D(DUOUT)) Q 0
  1.  Q $S(Y(0)="YES":1,1:0)
  1.  ;
  1.  ;Option to replace existing dialog elements
  1.  ;------------------------------------------
  1. REPL(INP) ;
  1.  N DIR,X,Y
  1.  S DIR(0)="Y",DIR("B")="NO"
  1.  S DIR("A")="REPLACE ANY EXISTING DIALOG ELEMENTS"
  1.  S DIR("?")="Enter Y or N. For detailed help type ??"
  1.  S DIR("??")=U_"D HELP^PXRMDBLD(3)"
  1.  D ^DIR K DIR
  1.  I $D(DIROUT) S DTOUT=1
  1.  I $D(DTOUT)!($D(DUOUT)) Q
  1.  S INP=$S(Y(0)="YES":1,1:0)
  1.  Q
  1.  ;
  1.  ;Reminder selection
  1.  ;------------------
  1. SEL(FILE,MODE,ARRAY) ;
  1.  N X,Y,CNT
  1.  K DIROUT,DIRUT,DTOUT,DUOUT
  1.  S CNT=0
  1.  W !
  1.  F  D  Q:$D(DTOUT)  Q:$D(DUOUT)  Q:CNT>0  Q:(Y=-1)&(CNT>0)
  1.  .S DIC=FILE,DIC(0)=MODE
  1.  .D ^DIC
  1.  .I X=(U_U) S DTOUT=1
  1.  .I '$D(DTOUT),('$D(DUOUT)) D
  1.  ..I +Y'=-1 D  Q
  1.  ...S CNT=CNT+1,ARRAY(CNT)=Y_U_Y(0,0)_U_$P(Y(0),U,3)
  1.  ..W:CNT=0 !,LIT1
  1.  .K DIC
  1.  Q
  1.  ;
  1. CONFIRM(YESNO,NAME) ;
  1.  N X,Y,TEXT,DIR
  1.  K DIROUT,DIRUT,DTOUT,DUOUT
  1.  S DIR(0)="YA0"
  1.  S DIR("A")="YOU ARE ABOUT TO OVERWRITE THE EXISTING DIALOG "_NAME_" CONTINUE? "
  1.  S DIR("B")="N"
  1.  S DIR("?")="Enter Y or N. For detailed help type ??"
  1.  S DIR("??")=U_"D HELP^PXRMDBLD(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))
  1.  Q
  1.  ;
  1.  ;General help text routine.
  1.  ;--------------------------
  1. HELP(CALL) ;
  1.  N HTEXT
  1.  N DIWF,DIWL,DIWR,IC
  1.  S DIWF="C75",DIWL=0,DIWR=75
  1.  ;
  1.  I CALL=1 D
  1.  .S HTEXT(1)="Enter Yes to generate reminder dialog automatically for a"
  1.  .S HTEXT(2)="selected reminder. Enter No to create a reminder dialog"
  1.  .S HTEXT(3)="using the standard fileman edit."
  1.  I CALL=2 D
  1.  .S HTEXT(1)="Enter Yes to replace the existing reminder dialog."
  1.  .S HTEXT(2)="Enter No to return and enter an alternative dialog name."
  1.  I CALL=3 D
  1.  .S HTEXT(1)="For each FINDING ITEM on the reminder a dialog element"
  1.  .S HTEXT(2)="will be created. A separate DIALOG ELEMENT is created for"
  1.  .S HTEXT(3)="each enabled RESOLUTION STATUS in the FINDING TYPE"
  1.  .S HTEXT(4)="PARAMETERS for this finding type. The dialog element is"
  1.  .S HTEXT(5)="unique for finding type, finding item name and resolution"
  1.  .S HTEXT(6)="status name."
  1.  .S HTEXT(7)="e.g. VM WEIGHT DONE will be generated for the finding item"
  1.  .S HTEXT(8)="     vitals measurement/weight."
  1.  .S HTEXT(9)=""
  1.  .S HTEXT(10)="Enter Yes to rebuild all dialog elements used by this"
  1.  .S HTEXT(11)="reminder overwriting any existing modifications."
  1.  .S HTEXT(12)=""
  1.  .S HTEXT(13)="Enter No to use existing dialog elements if they exist."
  1.  .S HTEXT(14)="New dialog elements will be created if they don't already"
  1.  .S HTEXT(15)="exist."
  1.  I CALL=4 D
  1.  .S HTEXT(1)="Enter Yes to create a dialog enabled for use in CPRS."
  1.  .S HTEXT(2)="Enter No to create a dialog disabled for CPRS."
  1.  I CALL=5 D
  1.  .S HTEXT(1)="If the source reminder is not linked to any other dialog"
  1.  .S HTEXT(2)="enter Yes to link the reminder to the generated dialog."
  1.  .S HTEXT(3)="Enter No if no link should be made."
  1.  I CALL=6 D
  1.  .S HTEXT(1)="Enter the name of the dialog. The default is the reminder"
  1.  .S HTEXT(2)="name. If the name of an existing dialog is specified the"
  1.  .S HTEXT(3)="option to override the existing dialog will be given."
  1.  K ^UTILITY($J,"W")
  1.  S IC=""
  1.  F  S IC=$O(HTEXT(IC)) Q:IC=""  D
  1.  . S X=HTEXT(IC)
  1.  . D ^DIWP
  1.  W !
  1.  S IC=0
  1.  F  S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC=""  D
  1.  . W !,^UTILITY($J,"W",0,IC,0)
  1.  K ^UTILITY($J,"W")
  1.  W !
  1.  Q