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

PXRMDLST.m

Go to the documentation of this file. 
  1. PXRMDLST ; SLC/PJH - Reminder Dialog Inquiry ;07/31/2009
  1.  ;;2.0;CLINICAL REMINDERS;**12**;Feb 04, 2005;Build 73
  1.  ;
  1.  ;
  1. START N BY,DC,DHD,DIC,EXPAND,FLDS,FR,L,LIT,LOGIC,NOW,TO,Y
  1.  N PXRMFIEN,PXRMHD
  1.  ;
  1.  S LIT="ALL DIALOGS"
  1.  I PXRMDTYP="R" S LIT="REMINDER DIALOGS"
  1.  I PXRMDTYP="P" S LIT="DIALOG PROMPTS"
  1.  I PXRMDTYP="F" S LIT="DIALOG FORCED VALUES"
  1.  I PXRMDTYP="E" S LIT="DIALOG ELEMENTS"
  1.  I PXRMDTYP="G" S LIT="DIALOG GROUPS"
  1.  ;
  1.  ;DIC is killed by DIP.
  1. SELECT S DIC="^PXRMD(801.41,"
  1.  S DIC(0)="AEMQ"
  1.  S DIC("A")="Select Dialog Definition: "
  1.  ;Current dialog type only
  1.  S DIC("S")="I $P(^(0),U,4)=PXRMDTYP"
  1.  D ^DIC
  1.  I Y'=-1 D  G SELECT
  1.  .;^DIP options
  1.  .D SET
  1.  .D DISP
  1. END Q
  1.  ;
  1.  ;List all (for protocol PXRM SELECTION LIST)
  1.  ;--------
  1. ALL N BY,DC,DHD,DIC,DIS,FLDS,FR,L,LIT,LOGIC,NOW,TO,Y
  1.  S LIT="ALL DIALOGS"
  1.  I PXRMDTYP="R" S LIT="REMINDER DIALOGS"
  1.  I PXRMDTYP="P" S LIT="DIALOG PROMPTS"
  1.  I PXRMDTYP="E" S LIT="DIALOG ELEMENTS"
  1.  I PXRMDTYP="G" S LIT="DIALOG GROUPS"
  1.  I PXRMDTYP="F" S LIT="DIALOG FORCED VALUES"
  1.  I $G(PXRMGTYP)="DLG" S LIT="REMINDER DIALOGS"
  1.  S Y=1
  1.  D SET
  1.  S DIC="^PXRMD(801.41,"
  1.  ;
  1.  I PXRMDTYP'="A" S DIS(0)="I $P($G(^PXRMD(801.41,D0,0)),U,4)=PXRMDTYP"
  1.  S BY=".01"
  1.  S FR=""
  1.  S TO=""
  1.  S DHD="W ?0 D HED^PXRMDLST"
  1.  D DISP
  1.  Q
  1.  ;
  1.  ;Inquire/Print Option (for protocol PXRM GENERAL INQUIRE/PRINT)
  1.  ;--------------------
  1. INQ(Y) N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO
  1.  S DIC="^PXRMD(801.41,"
  1.  S DIC(0)="AEMQ"
  1.  D SET
  1.  D DISP
  1.  Q
  1.  ;
  1.  ;Inquiry/Print for dialog edit (for protocol PXRM DIALOG SELECTION INQ)
  1.  ;-----------------------------
  1. INQ1 W IORESET
  1.  D START
  1.  Q
  1.  ;
  1.  ;
  1.  ;Display using print templates
  1.  ;-----------------------------
  1. DISP S L=0,FLDS="[PXRM REMINDER DIALOG]"
  1.  I PXRMDTYP="E" S FLDS="[PXRM DIALOG ELEMENT]"
  1.  I PXRMDTYP="F" S FLDS="[PXRM DIALOG FORCED VALUE]"
  1.  I PXRMDTYP="G" S FLDS="[PXRM DIALOG GROUP]"
  1.  I PXRMDTYP="P" S FLDS="[PXRM DIALOG PROMPT]"
  1.  I PXRMDTYP="S" S FLDS="[PXRM RESULT GROUP]"
  1.  I PXRMDTYP="T" S FLDS="[PXRM RESULT ELEMENT]"
  1.  ;
  1.  D EN1^DIP
  1.  Q
  1.  ;
  1.  ;Header
  1.  ;------
  1. HED N TEMP,TEXTLEN,TEXTHED,TEXTUND
  1.  S TEXTHED="REMINDER DIALOG INQUIRY"
  1.  S TEXTUND=$TR($J("",IOM)," ","-")
  1.  S TEMP=NOW_"  Page "_DC
  1.  S TEXTLEN=$L(TEMP)
  1.  W TEXTHED
  1.  W ?(IOM-TEXTLEN),TEMP
  1.  W !,TEXTUND,!!
  1.  Q
  1.  ;
  1.  ;Get question text
  1.  ;-----------------
  1. PROMPT N DTYP,FIRST,NODE,SUB,LINE,TAB
  1.  S SUB=$P(X,U,2) Q:SUB=""
  1.  S DTYP=$P($G(^PXRMD(801.41,SUB,0)),U,4) Q:DTYP=""
  1.  ;Dialog element
  1.  I DTYP="E" D  Q
  1.  .S NODE=0,FIRST=1,TAB=26
  1.  .F  S NODE=$O(^PXRMD(801.41,SUB,25,NODE)) Q:'NODE  D
  1.  ..S LINE=$G(^PXRMD(801.41,SUB,25,NODE,0))
  1.  ..I 'FIRST W !
  1.  ..I FIRST,$L(LINE)>50 W ! S TAB=2
  1.  ..W ?TAB,LINE
  1.  ;Prompt/Forced Value
  1.  I "FP"[DTYP W $P($G(^PXRMD(801.41,SUB,2)),U,4)
  1.  Q
  1.  ;
  1. SET ;Setup all the variables
  1.  ; Set Date for Header
  1.  S NOW=$$NOW^XLFDT
  1.  S NOW=$$FMTE^XLFDT(NOW,"1P")
  1.  ;
  1.  ;These variables need to be setup every time because DIP kills them.
  1.  S BY="NUMBER"
  1.  S (FR,TO)=+$P(Y,U,1)
  1.  S DHD="W ?0 D HED^PXRMDLST"
  1.  ;
  1.  Q
  1.  ;
  1.  ;Orderable item
  1.  ;--------------
  1. ORDER I '$G(D0) Q
  1.  N QNAM,QORDER,RIEN,RNAM
  1.  S RIEN=$P($G(^PXRMD(801.41,D0,1)),U,3),RNAM=""
  1.  I RIEN S RNAM=$P($G(^PXRMD(801.9,RIEN,0)),U)
  1.  I RNAM'="ORDERED" W ?24,"N/A" Q
  1.  S QORDER=$P($G(^PXRMD(801.41,D0,1)),U,7)
  1.  I 'QORDER W ?24,"None" Q
  1.  S QNAM=$P($G(^ORD(101.43,QORDER,0)),U) I QNAM="" S QNAM="Unknown"
  1.  W ?24,QNAM," (OI["_QORDER_"])"
  1.  Q
  1.  ;
  1.  ;Dialog ELEMENT pointed to by REMINDER DIALOGS/GROUPS
  1.  ;"AGP NO LONGER USED REPLACE BY USE"
  1.  ;----------------------------------------------------
  1. REPLACE(DIEN,TAB,CUR) ;
  1.  Q:'$G(DIEN)
  1.  N DATA,DSUB,DENAM,DETYP,DTLIT,DMES
  1.  S DSUB=0
  1.  F  S DSUB=$O(^PXRMD(801.41,"R",DIEN,DSUB)) Q:'DSUB  D
  1.  .S DATA=$G(^PXRMD(801.41,DSUB,0)) Q:DATA=""
  1.  .S DENAM=$P(DATA,U) Q:DENAM=""
  1.  .S DETYP=$P(DATA,U,4) Q:DETYP=""
  1.  .S DTLIT="??",DMES="" S:CUR=DSUB DMES="Current "
  1.  .I DETYP="G" S DTLIT="Dialog Group"
  1.  .I DETYP="E" S DTLIT="Dialog Element"
  1.  .W ?TAB,DENAM_" ("_DMES_DTLIT_")",!
  1.  Q
  1.  ;
  1. USE(DIEN,TAB,CUR,XREF) ;
  1.  Q:'$G(DIEN)
  1.  N DATA,DSUB,DENAM,DETYP,DTLIT,DMES
  1.  S DSUB=0
  1.  F  S DSUB=$O(^PXRMD(801.41,XREF,DIEN,DSUB)) Q:'DSUB  D
  1.  .S DATA=$G(^PXRMD(801.41,DSUB,0)) Q:DATA=""
  1.  .S DENAM=$P(DATA,U) Q:DENAM=""
  1.  .S DETYP=$P(DATA,U,4) Q:DETYP=""
  1.  .S DTLIT="??",DMES="" S:CUR=DSUB DMES="Current "
  1.  .I DETYP="R" S DTLIT="Reminder Dialog"
  1.  .I DETYP="G" S DTLIT="Dialog Group"
  1.  .I DETYP="E" S DTLIT="Dialog Element"
  1.  .I DETYP="S" S DTLIT="Result Group"
  1.  .W ?TAB,DENAM_" ("_DMES_DTLIT_")",!
  1.  Q