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

PXRMFIND.m

Go to the documentation of this file.
  1. PXRMFIND ; SLC/PJH - Edit/Inquire finding type parameters ;08/21/2014
  1. ;;2.0;CLINICAL REMINDERS;**47**;Feb 04, 2005;Build 291
  1. ;
  1. START N DIC,FTYP,PXRMGTYP,PXRMHD,PXRMFIEN,PXRMFSUB,Y
  1. ;Get lists of finding types for display
  1. ;N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
  1. N DEF2,IND,TEMP
  1. S IND=0
  1. F S IND=+$O(^DD(801.41,15,"V",IND)) Q:IND=0 D
  1. . S TEMP=^DD(801.41,15,"V",IND,0)
  1. . S DEF2($P(TEMP,U,4))=$P(TEMP,U,2),DEF2($P(TEMP,U,4),1)=$P(TEMP,U)
  1. S DEF2("OI")="ORDERABLE ITEM",DEF2("OI",1)=101.43
  1. SELECT ;General selection
  1. S PXRMHD="Finding Type Parameters",PXRMFIEN="",PXRMGTYP="FPAR"
  1. D START^PXRMSEL(PXRMHD,PXRMGTYP,"PXRMFIEN")
  1. ;Should return a value
  1. I PXRMFIEN D G SELECT
  1. .;Format headings to include category name
  1. .S PXRMHD="FINDING TYPE PARAMETER NAME: "
  1. .S FTYP=$P(^PXRMD(801.45,PXRMFIEN,0),U)
  1. .I FTYP="POV" S PXRMHD=PXRMHD_FTYP_" - Diagnosis (Taxonomy)"
  1. .I FTYP="CPT" S PXRMHD=PXRMHD_FTYP_" - Procedure (Taxonomy)"
  1. .I $D(DEF2(FTYP)) S PXRMHD=PXRMHD_FTYP_" - "_DEF2(FTYP)
  1. .;Install option allows extended edit/add/delete
  1. .I $G(PXRMINST)=1 D START^PXRMGEN(PXRMHD,PXRMGTYP,PXRMFIEN) Q
  1. .;Otherwise limited edit options
  1. .F D Q:'PXRMFSUB
  1. ..S PXRMFSUB="" D START^PXRMFPAR(PXRMHD,PXRMFIEN)
  1. ..I PXRMFSUB D
  1. ...N X
  1. ...S X="IORESET"
  1. ...D ENDR^%ZISS
  1. ...D EDIT^PXRMGEDT(PXRMGTYP,PXRMFSUB,1)
  1. END Q
  1. ;
  1. ;Called from PXRM SELECTION LIST
  1. ;-------------------------------
  1. FPAR N ACNT,ADES,AIEN,ASUB,ATYP,DATA,LCT,PTXT,RDES,RDIS,RIEN,STRING,STXT,SUB
  1. S VALMCNT=0 K ^TMP("PXRMGENS",$J),^TMP("PXRMGEN",$J)
  1. S SUB=0
  1. ;Loop through all the resolution statuses
  1. F S SUB=$O(^PXRMD(801.45,IEN,1,SUB)) Q:'SUB D
  1. .;Get ien for resolution status
  1. .S RIEN=$P($G(^PXRMD(801.45,IEN,1,SUB,0)),U) Q:RIEN=""
  1. .;Get description
  1. .S RDES=$P($G(^PXRMD(801.9,RIEN,0)),U) I RDES="" S RDES=RIEN
  1. .;Get Prefix and suffix text
  1. .S PTXT=$E($G(^PXRMD(801.45,IEN,1,SUB,3)),1,40)
  1. .S STXT=$E($G(^PXRMD(801.45,IEN,1,SUB,4)),1,40)
  1. .;Get disabled flag
  1. .S RDIS=$P($G(^PXRMD(801.45,IEN,1,SUB,0)),U,2)
  1. .S RDIS=$S(RDIS=1:"Disabled",1:"Enabled")
  1. .;Save Resolution in alpha order
  1. .S ^TMP("PXRMGENS",$J,RDES)=SUB_U_PTXT_U_STXT_U_RDIS
  1. ;
  1. ;Put the list into the array List Manager is using.
  1. S RDES="",LCT=0
  1. S VALMCNT=0
  1. F S RDES=$O(^TMP("PXRMGENS",$J,RDES)) Q:RDES="" D
  1. .S DATA=$G(^TMP("PXRMGENS",$J,RDES))
  1. .S SUB=$P(DATA,U),PTXT=$P(DATA,U,2),STXT=$P(DATA,U,3),RDIS=$P(DATA,U,4)
  1. .S VALMCNT=VALMCNT+1,LCT=LCT+1
  1. .S STRING=LCT_" "_RDES_$J("",(27-$L(RDES)))_PTXT_"/"
  1. .S ^TMP("PXRMGEN",$J,VALMCNT,0)=STRING_$J("",71-$L(STRING))_RDIS
  1. .S VALMCNT=VALMCNT+1
  1. .S ^TMP("PXRMGEN",$J,VALMCNT,0)=$J("",29)_"/"_STXT
  1. .S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
  1. .;Then get the additional prompts/forced values
  1. .S ASUB=0,ACNT=0
  1. .F S ASUB=$O(^PXRMD(801.45,IEN,1,SUB,5,ASUB)) Q:'ASUB D
  1. ..;Get prompt ien
  1. ..S AIEN=$P($G(^PXRMD(801.45,IEN,1,SUB,5,ASUB,0)),U) 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)=$J("",29)_ACNT_"] "_ADES_ATYP
  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. K ^TMP("PXRMGENS",$J)
  1. ;Create headings
  1. D CHGCAP^VALM("HEADER1","Resolution Status")
  1. D CHGCAP^VALM("HEADER2","Prefix//Suffix & Prompts/Values/Actions")
  1. D CHGCAP^VALM("HEADER3","Status")
  1. Q