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

PXRMFIP.m

Go to the documentation of this file. 
  1. PXRMFIP ; SLC/PJH - Edit/Inquire Finding Item Parameters ;03/09/2000
  1.  ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
  1.  ;
  1.  ;General selection
  1. START N DIC,PXRMGTYP,PXRMHD,Y
  1. SELECT ;Get lists of finding types for display
  1.  N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
  1.  S PXRMHD="Finding Item Parameters",PXRMFIP="",PXRMGTYP="FIP"
  1.  D START^PXRMSEL(PXRMHD,PXRMGTYP,"PXRMFIP")
  1.  ;Should return a value
  1.  I PXRMFIP D  G SELECT
  1.  .S PXRMHD="FINDING ITEM PARAMETER NAME:"
  1.  .;Listman option
  1.  .D START^PXRMGEN(PXRMHD,PXRMGTYP,PXRMFIP)
  1.  ;
  1. END Q
  1.  ;
  1.  ;List all finding item parameters (for protocol PXRM SELECTION LIST)
  1.  ;--------------------------------
  1. ALL N BY,DC,DHD,DIC,FLDS,FR,L,LOGIC,NOW,TO,Y
  1.  S Y=1
  1.  D SET
  1.  S DIC="^PXRMD(801.43,"
  1.  S BY=".01"
  1.  S FR=""
  1.  S TO=""
  1.  S DHD="W ?0 D HED^PXRMFIP"
  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.43,"
  1.  S DIC(0)="AEMQ"
  1.  D SET
  1.  D DISP
  1.  Q
  1.  ;
  1.  ;Display Header (see DHD variable)
  1.  ;--------------
  1. HED N TEMP,TEXTLEN,TEXTHED,TEXTUND
  1.  S TEXTHED="FINDING ITEM PARAMETER LIST"
  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.  ;DISPLAY (Display from FLDS array)
  1.  ;-------
  1. DISP S L=0,FLDS="[PXRM FINDING ITEM PARAMETERS]"
  1.  D EN1^DIP
  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^PXRMFIP"
  1.  ;
  1.  Q
  1.  ;
  1.  ;Build display for selected finding item parametr - Called from PXRMGEN
  1.  ;----------------------------------------------------------------------
  1. FIP(PXRMFIP) ;
  1.  N DATA,DDIS,DNAM,DIEN,DHED,DTYP,FDES,FDIS,FITEM,FGLOB,FLIT,FSUB,FTYP
  1.  N HED1,HED2,LCT,SUB
  1.  S VALMCNT=0 K ^TMP("PXRMGENS",$J),^TMP("PXRMGEN",$J)
  1.  ;Format headings to include finding item parameter name
  1.  S DATA=$G(^PXRMD(801.43,PXRMFIP,0)),FDES=$P(DATA,U),FDIS=$P(DATA,U,3)
  1.  S HEADER=PXRMHD_" "_FDES_"  ("_$S(FDIS:"DISABLED",1:"ENABLED")_")"
  1.  ;Dialog ien
  1.  S DATA=$G(^PXRMD(801.43,PXRMFIP,0)),DIEN=$P(DATA,U,4)
  1.  ;Finding Item
  1.  S FITEM=$P(DATA,U,2),FTYP=$P(FITEM,";",2),FSUB=$P(FITEM,";")
  1.  S FLIT="??",FDES=$P(DATA,U)
  1.  I FTYP]"" S FTYP=$G(DEF1(FTYP)) S:FTYP="" FTYP="??"
  1.  I FSUB,FTYP'="??" D
  1.  .S FLIT=FTYP_"("_FSUB_")",FGLOB=U_$P(FITEM,";",2)_FSUB_",0)"
  1.  .S FDES=$P($G(@FGLOB),U) I FDES="" S FDES="??"
  1.  S HED1="Finding Type: "_FLIT
  1.  S HED2="Finding Item: "_FDES
  1.  ;Dialog details 
  1.  I DIEN S DATA=$G(^PXRMD(801.41,DIEN,0))
  1.  ;Unknown pointer
  1.  I ('DIEN)!(DATA="") D  Q
  1.  .S VALMCNT=VALMCNT+1
  1.  .S ^TMP("PXRMGEN",$J,VALMCNT,0)="Bad Pointer to Dialog File"
  1.  .S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
  1.  ;Dialog type, name and disabled flag
  1.  S DTYP=$P(DATA,U,4)
  1.  S DHED=$S(DTYP="G":"Group",DTYP="E":"Element",1:"??")
  1.  ;
  1.  ;Dialog Element Details
  1.  I DTYP="E" D ELEMENT(DIEN,"")
  1.  ;
  1.  ;Dialog Group Details
  1.  I DTYP="G" D
  1.  .S DDIS=$P(DATA,U,3),DNAM=$P(DATA,U)
  1.  .S DNAM=DNAM_"  ("_$S(DDIS:"DISABLED",1:"ENABLED")_")"
  1.  .S VALMCNT=VALMCNT+1
  1.  .S ^TMP("PXRMGEN",$J,VALMCNT,0)=$J("",79)
  1.  .S VALMCNT=VALMCNT+1
  1.  .S ^TMP("PXRMGEN",$J,VALMCNT,0)="Dialog Group: "_DNAM
  1.  .S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
  1.  .;
  1.  .N DSEQ,EIEN,SUB S SUB=0
  1.  .;Loop through group for elements
  1.  .F  S SUB=$O(^PXRMD(801.41,DIEN,10,SUB)) Q:'SUB  D
  1.  ..S DATA=$G(^PXRMD(801.41,DIEN,10,SUB,0)) Q:DATA=""
  1.  ..S DSEQ=$P(DATA,U) Q:'DSEQ  S EIEN=$P(DATA,U,2) Q:'EIEN
  1.  ..;Save dialog elements in sequence order
  1.  ..S ^TMP("PXRMGENS",$J,DSEQ)=EIEN
  1.  .;
  1.  .;Put the list into the array List Manager is using.
  1.  .S DSEQ="",LCT=0
  1.  .F  S DSEQ=$O(^TMP("PXRMGENS",$J,DSEQ)) Q:DSEQ=""  D
  1.  ..S EIEN=$G(^TMP("PXRMGENS",$J,DSEQ)) Q:'EIEN
  1.  ..D ELEMENT(EIEN,DSEQ)
  1.  .;Final linefeed
  1.  .S VALMCNT=VALMCNT+1
  1.  .S ^TMP("PXRMGEN",$J,VALMCNT,0)=$J("",79)
  1.  .S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
  1.  ;
  1.  K ^TMP("PXRMGENS",$J)
  1.  ;Create headings
  1.  D CHGCAP^VALM("HEADER1",HED1)
  1.  D CHGCAP^VALM("HEADER2",HED2)
  1.  D CHGCAP^VALM("HEADER3","")
  1.  Q
  1.  ;
  1.  ;Dialog Element Details
  1.  ;----------------------
  1. ELEMENT(DIEN,DSEQ) ;
  1.  N DATA,DNAM,DDIS,DTXT,TSUB,TXT
  1.  S DATA=$G(^PXRMD(801.41,DIEN,0)) Q:DATA=""
  1.  S DDIS=$P(DATA,U,3),DNAM=$P(DATA,U)
  1.  S DNAM=DNAM_"  ("_$S(DDIS:"DISABLED",1:"ENABLED")_")"
  1.  S TXT="Dialog Element: "_DNAM
  1.  I DSEQ S TXT=$J(DSEQ,2)_") "_TXT
  1.  I 'DSEQ S TXT="    "_TXT
  1.  S VALMCNT=VALMCNT+1
  1.  S ^TMP("PXRMGEN",$J,VALMCNT,0)=$J("",79)
  1.  S VALMCNT=VALMCNT+1
  1.  S ^TMP("PXRMGEN",$J,VALMCNT,0)=TXT
  1.  S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
  1.  ;Dialog Text
  1.  S TSUB=0,TXT="    Dialog Text: "
  1.  F  S TSUB=$O(^PXRMD(801.41,DIEN,25,TSUB)) Q:'TSUB  D
  1.  .S DTXT=$G(^PXRMD(801.41,DIEN,25,TSUB,0))
  1.  .S VALMCNT=VALMCNT+1
  1.  .S ^TMP("PXRMGEN",$J,VALMCNT,0)=TXT_DTXT
  1.  .S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT,TXT=$J("",17)
  1.  ;Additional prompts/forced values
  1.  N ACNT,ADES,AIEN,ASUB,ATYP,DATA
  1.  S ASUB=0,ACNT=0,TXT="    Additional Prompts: "
  1.  F  S ASUB=$O(^PXRMD(801.41,DIEN,10,ASUB)) Q:'ASUB  D
  1.  .;Get prompt ien
  1.  .S AIEN=$P($G(^PXRMD(801.41,DIEN,10,ASUB,0)),U,2) Q:AIEN=""
  1.  .;Get description and type from dialog file
  1.  .S DATA=$G(^PXRMD(801.41,AIEN,0))
  1.  .S ADES=$P(DATA,U) I ADES="" S ADES=AIEN
  1.  .S ATYP="" I $P(DATA,U,4)="F" S ATYP=" (forced value)"
  1.  .S VALMCNT=VALMCNT+1,ACNT=ACNT+1
  1.  .S ^TMP("PXRMGEN",$J,VALMCNT,0)=TXT_ADES_ATYP,TXT=$J("",24)
  1.  .S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
  1.  I ACNT=0 D
  1.  .S VALMCNT=VALMCNT+1,ACNT=ACNT+1
  1.  .S ^TMP("PXRMGEN",$J,VALMCNT,0)=TXT_"*NONE*"
  1.  .S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
  1.  Q