source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMFIND.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.1 KB
Line 
1PXRMFIND ; SLC/PJH - Edit/Inquire finding type parameters ;01/21/2000
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4START N DIC,FTYP,PXRMGTYP,PXRMHD,PXRMFIEN,PXRMFSUB,Y
5 ;Get lists of finding types for display
6 N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
7SELECT ;General selection
8 S PXRMHD="Finding Type Parameters",PXRMFIEN="",PXRMGTYP="FPAR"
9 D START^PXRMSEL(PXRMHD,PXRMGTYP,"PXRMFIEN")
10 ;Should return a value
11 I PXRMFIEN D G SELECT
12 .;Format headings to include category name
13 .S PXRMHD="FINDING TYPE PARAMETER NAME: "
14 .S FTYP=$P(^PXRMD(801.45,PXRMFIEN,0),U)
15 .I FTYP="POV" S PXRMHD=PXRMHD_FTYP_" - Diagnosis (Taxonomy)"
16 .I FTYP="CPT" S PXRMHD=PXRMHD_FTYP_" - Procedure (Taxonomy)"
17 .I $D(DEF2(FTYP)) S PXRMHD=PXRMHD_FTYP_" - "_DEF2(FTYP)
18 .;Install option allows extended edit/add/delete
19 .I $G(PXRMINST)=1 D START^PXRMGEN(PXRMHD,PXRMGTYP,PXRMFIEN) Q
20 .;Otherwise limited edit options
21 .F D Q:'PXRMFSUB
22 ..S PXRMFSUB="" D START^PXRMFPAR(PXRMHD,PXRMFIEN)
23 ..I PXRMFSUB D
24 ...N X
25 ...S X="IORESET"
26 ...D ENDR^%ZISS
27 ...D EDIT^PXRMGEDT(PXRMGTYP,PXRMFSUB,1)
28END Q
29 ;
30 ;Called from PXRM SELECTION LIST
31 ;-------------------------------
32FPAR N ACNT,ADES,AIEN,ASUB,ATYP,DATA,LCT,PTXT,RDES,RDIS,RIEN,STRING,STXT,SUB
33 S VALMCNT=0 K ^TMP("PXRMGENS",$J),^TMP("PXRMGEN",$J)
34 S SUB=0
35 ;Loop through all the resolution statuses
36 F S SUB=$O(^PXRMD(801.45,IEN,1,SUB)) Q:'SUB D
37 .;Get ien for resolution status
38 .S RIEN=$P($G(^PXRMD(801.45,IEN,1,SUB,0)),U) Q:RIEN=""
39 .;Get description
40 .S RDES=$P($G(^PXRMD(801.9,RIEN,0)),U) I RDES="" S RDES=RIEN
41 .;Get Prefix and suffix text
42 .S PTXT=$E($G(^PXRMD(801.45,IEN,1,SUB,3)),1,40)
43 .S STXT=$E($G(^PXRMD(801.45,IEN,1,SUB,4)),1,40)
44 .;Get disabled flag
45 .S RDIS=$P($G(^PXRMD(801.45,IEN,1,SUB,0)),U,2)
46 .S RDIS=$S(RDIS=1:"Disabled",1:"Enabled")
47 .;Save Resolution in alpha order
48 .S ^TMP("PXRMGENS",$J,RDES)=SUB_U_PTXT_U_STXT_U_RDIS
49 ;
50 ;Put the list into the array List Manager is using.
51 S RDES="",LCT=0
52 S VALMCNT=0
53 F S RDES=$O(^TMP("PXRMGENS",$J,RDES)) Q:RDES="" D
54 .S DATA=$G(^TMP("PXRMGENS",$J,RDES))
55 .S SUB=$P(DATA,U),PTXT=$P(DATA,U,2),STXT=$P(DATA,U,3),RDIS=$P(DATA,U,4)
56 .S VALMCNT=VALMCNT+1,LCT=LCT+1
57 .S STRING=LCT_" "_RDES_$J("",(27-$L(RDES)))_PTXT_"/"
58 .S ^TMP("PXRMGEN",$J,VALMCNT,0)=STRING_$J("",71-$L(STRING))_RDIS
59 .S VALMCNT=VALMCNT+1
60 .S ^TMP("PXRMGEN",$J,VALMCNT,0)=$J("",29)_"/"_STXT
61 .S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
62 .;Then get the additional prompts/forced values
63 .S ASUB=0,ACNT=0
64 .F S ASUB=$O(^PXRMD(801.45,IEN,1,SUB,5,ASUB)) Q:'ASUB D
65 ..;Get prompt ien
66 ..S AIEN=$P($G(^PXRMD(801.45,IEN,1,SUB,5,ASUB,0)),U) Q:AIEN=""
67 ..;Get description and type from dialog file
68 ..S DATA=$G(^PXRMD(801.41,AIEN,0))
69 ..S ADES=$P(DATA,U) I ADES="" S ADES=AIEN
70 ..S ATYP="" I $P(DATA,U,4)="F" S ATYP=" (forced value)"
71 ..S VALMCNT=VALMCNT+1,ACNT=ACNT+1
72 ..S ^TMP("PXRMGEN",$J,VALMCNT,0)=$J("",29)_ACNT_"] "_ADES_ATYP
73 .;Final linefeed
74 .S VALMCNT=VALMCNT+1
75 .S ^TMP("PXRMGEN",$J,VALMCNT,0)=$J("",79)
76 .S ^TMP("PXRMGEN",$J,"VALMCNT")=VALMCNT
77 K ^TMP("PXRMGENS",$J)
78 ;Create headings
79 D CHGCAP^VALM("HEADER1","Resolution Status")
80 D CHGCAP^VALM("HEADER2","Prefix//Suffix & Prompts/Values/Actions")
81 D CHGCAP^VALM("HEADER3","Status")
82 Q
Note: See TracBrowser for help on using the repository browser.