source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMFPAR.m@ 1806

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

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1PXRMFPAR ; SLC/PJH - PXRM Finding Type Parameter Edit/Inquiry; 01/21/2000
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;Labels called from list 'PXRM FINDING PARAMETER LIST'
5 ;
6START(HEADER,IEN) ;
7 N PXRMREAD,PXRMSRC,PXRMVARM
8 N VALM,VAKMAR,VALMBCK,VALMBG,VALMCNT,VALMHDR,VALMSG,X,XMZ
9 S X="IORESET"
10 D ENDR^%ZISS
11 D EN^VALM("PXRM FINDING PARAMETER LIST")
12 W IORESET
13 D KILL^%ZISS
14 Q
15 ;
16EXIT ;Exit code
17 D CLEAN^VALM10
18 D FULL^VALM1
19 S VALMBCK="Q"
20 K ^TMP("PXRMFP",$J)
21 Q
22 ;
23HDR ; Header code
24 S VALMHDR(1)=HEADER
25 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
26 Q
27 ;
28HELP ;Help code
29 N ORU,ORUPRMT,XQORM,PXRMTAG S PXRMTAG="G"_PXRMGTYP
30 D EN^VALM("PXRM DIALOG MAIN HELP")
31 Q
32 ;
33INIT ;Init
34 S VALMCNT=0
35 D BUILD
36 D XQORM
37 Q
38 ;
39 ;Load details
40BUILD N ACNT,ADES,AIEN,ASUB,ATYP,DATA,LCT,PTXT,RDES,RDIS,RIEN,STRING,STXT,SUB
41 S VALMCNT=0 K ^TMP("PXRMFPS",$J),^TMP("PXRMFP",$J)
42 S SUB=0
43 ;Loop through all the resolution statuses
44 F S SUB=$O(^PXRMD(801.45,IEN,1,SUB)) Q:'SUB D
45 .;Get ien for resolution status
46 .S RIEN=$P($G(^PXRMD(801.45,IEN,1,SUB,0)),U) Q:RIEN=""
47 .;Get description
48 .S RDES=$P($G(^PXRMD(801.9,RIEN,0)),U) I RDES="" S RDES=RIEN
49 .;Get Prefix and suffix text
50 .S PTXT=$E($G(^PXRMD(801.45,IEN,1,SUB,3)),1,40)
51 .S STXT=$E($G(^PXRMD(801.45,IEN,1,SUB,4)),1,40)
52 .;Get disabled flag
53 .S RDIS=$P($G(^PXRMD(801.45,IEN,1,SUB,0)),U,2)
54 .S RDIS=$S(RDIS=1:"Disabled",1:"Enabled")
55 .;Save Resolution in alpha order
56 .S ^TMP("PXRMFPS",$J,RDES)=SUB_U_PTXT_U_STXT_U_RDIS
57 ;
58 ;Put the list into the array List Manager is using.
59 S RDES="",LCT=0
60 S VALMCNT=0
61 F S RDES=$O(^TMP("PXRMFPS",$J,RDES)) Q:RDES="" D
62 .S DATA=$G(^TMP("PXRMFPS",$J,RDES))
63 .S SUB=$P(DATA,U),PTXT=$P(DATA,U,2),STXT=$P(DATA,U,3),RDIS=$P(DATA,U,4)
64 .S LCT=LCT+1,VALMCNT=VALMCNT+1
65 .S STRING=LCT_" "_RDES_$J("",(27-$L(RDES)))_PTXT_"/"
66 .S ^TMP("PXRMFP",$J,VALMCNT,0)=STRING_$J("",71-$L(STRING))_RDIS
67 .S VALMCNT=VALMCNT+1
68 .S ^TMP("PXRMFP",$J,VALMCNT,0)=$J("",29)_"/"_STXT
69 .S ^TMP("PXRMFP",$J,"VALMCNT")=VALMCNT
70 .S ^TMP("PXRMFP",$J,"IDX",LCT,SUB)=""
71 .;Then get the additional prompts/forced values
72 .S ASUB=0,ACNT=0
73 .F S ASUB=$O(^PXRMD(801.45,IEN,1,SUB,5,ASUB)) Q:'ASUB D
74 ..;Get prompt ien
75 ..S AIEN=$P($G(^PXRMD(801.45,IEN,1,SUB,5,ASUB,0)),U) Q:AIEN=""
76 ..;Get description and type from dialog file
77 ..S DATA=$G(^PXRMD(801.41,AIEN,0))
78 ..S ADES=$P(DATA,U) I ADES="" S ADES=AIEN
79 ..S ATYP="" I $P(DATA,U,4)="F" S ATYP=" (forced value)"
80 ..S VALMCNT=VALMCNT+1,ACNT=ACNT+1
81 ..S ^TMP("PXRMFP",$J,VALMCNT,0)=$J("",29)_ACNT_"] "_ADES_ATYP
82 .;Final linefeed
83 .S VALMCNT=VALMCNT+1
84 .S ^TMP("PXRMFP",$J,VALMCNT,0)=$J("",79)
85 .S ^TMP("PXRMFP",$J,"VALMCNT")=VALMCNT
86 K ^TMP("PXRMFPS",$J)
87 ;Create headings
88 D CHGCAP^VALM("HEADER1","Resolution Status")
89 D CHGCAP^VALM("HEADER2","Prefix//Suffix & Prompts/Values/Actions")
90 D CHGCAP^VALM("HEADER3","Status")
91 Q
92 ;
93PEXIT ;PXRM GENERAL MENU protocol exit code
94 S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
95 D XQORM
96 Q
97 ;
98SEL ;PXRM SELECT RESOLUTION validation
99 N ERR,IEN,SEL
100 S VALMBCK="",SEL=+$P(XQORNOD(0),"=",2)
101 ;Invalid selection
102 I '$D(@VALMAR@("IDX",SEL)) D Q
103 .W $C(7),!,SEL_" is not a valid item number." H 2
104 .S VALMBCK="R"
105 ;Valid selection
106 S IEN=$O(@VALMAR@("IDX",SEL,""))
107 I IEN D
108 .S VALMBCK="Q",PXRMFSUB=IEN
109 Q
110 ;
111XQORM S XQORM("#")=$O(^ORD(101,"B","PXRM SELECT RESOLUTION",0))_U_"1:"_VALMCNT
112 S XQORM("A")="Select number of Resolution Status to Edit: "
113 Q
Note: See TracBrowser for help on using the repository browser.