source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMDBL1.m@ 701

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

initial load of WorldVistAEHR

File size: 2.4 KB
Line 
1PXRMDBL1 ; SLC/PJH - Reminder Dialog Generation. ;04/19/2000
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;
4 ;Build Reminder Dialog
5 ;---------------------
6BUILD(REM,NAME,ARRAY) ;
7 ;Lock the entire file
8 L +^PXRMD(801.41):30
9 E W !!,?5,"Another user is editing this file, try later" H 4 Q
10 ;
11 N ACNT,ASUB,ATXT,CNT,DATA,DIEN,DNAME,DNODE,FGLOB,FITEM,FNODE,FSUB,FTYP
12 N INAME,MIEN,MSUB,PNAME,RESN,RNAME,RNODE,RPRE,RREQ,RSHORT,RSUB,RSUF
13 N TDMOD,TDPAR,TDX,TITEM,TPMOD,TPPAR,TPR,TSEQ,TSUB,TTYP
14 N TDHTXT,TDTXT,TPHTXT,TPTXT
15 N WPTXT,DSET,DSHORT
16 W !!,"Building dialog - "_NAME
17 ;
18 ;Upper and lower case transforms
19 N LOWER,UPPER
20 S LOWER="abcdefghijklmnopqrstuvwxyz"
21 S UPPER="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
22 ;
23 ;Build index of finding type to globals
24 N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
25 ;
26 ;Save name for use in building SET
27 S DSET(1)=NAME
28 ;
29 ;Get findings for this reminder
30 S FSUB=0,CNT=0
31 F S FSUB=$O(^PXD(811.9,REM,20,FSUB)) Q:'FSUB D
32 .S DATA=$G(^PXD(811.9,REM,20,FSUB,0)) Q:DATA=""
33 .;Single finding
34 .S RESN=$P(DATA,U)
35 .I $P(RESN,";",2)'="PXRMD(811.5," D FIND^PXRMDBL2(DATA) Q
36 .;Terms - 1st check finding item dialog file
37 .I $D(^PXRMD(801.43,"AC",RESN)) D Q:DIEN
38 ..S DIEN=$$OK(RESN) Q:'DIEN
39 ..;Create array used to build reminder dialog
40 ..S CNT=CNT+1,ARRAY(CNT)=801.43_U_DIEN
41 ..W !!,CNT,?5,"Finding item dialog "_$$FNAM(RESN)
42 .;Else process all the term findings
43 .S MIEN=$P($P(DATA,U),";") Q:'MIEN
44 .S MSUB=0
45 .F S MSUB=$O(^PXRMD(811.5,MIEN,20,MSUB)) Q:'MSUB D
46 ..S DATA=$G(^PXRMD(811.5,MIEN,20,MSUB,0)) Q:DATA=""
47 ..D FIND^PXRMDBL2(DATA)
48 ;
49 ;Update dialog file from FDA
50 D ^PXRMDBL3
51 ;Unlock the file
52 L -^PXRMD(801.41)
53 Q
54 ;
55 ;Get Finding Item name
56 ;---------------------
57FNAM(FIND) ;
58 N DATA,GLOB,NAME,NODE
59 S NAME="Unknown"
60 S NODE=$O(^PXRMD(801.43,"AC",FIND,"")) Q:'NODE NAME
61 S DATA=$G(^PXRMD(801.43,NODE,0)) Q:DATA="" NAME
62 I $P(DATA,U)'="" S NAME=$P(DATA,U)
63 S GLOB=$P($P(FIND,U),";",2) S:GLOB]"" NAME=$G(DEF1(GLOB))_" - "_NAME
64 Q NAME
65 ;
66 ;Checks if an enabled finding item dialog exists
67 ;-----------------------------------------------
68OK(FIND) ;
69 N DATA,DIEN,DTYP,NODE
70 S NODE=$O(^PXRMD(801.43,"AC",FIND,"")) Q:'NODE 0
71 S DATA=$G(^PXRMD(801.43,NODE,0)) Q:DATA="" 0
72 ;Ignore disabled entries
73 I $P(DATA,U,3) Q 0
74 ;Ignore finding item dialogs no longer valid
75 S DIEN=$P(DATA,U,4) Q:DIEN="" 0
76 S DATA=$G(^PXRMD(801.41,DIEN,0)) Q:DATA="" 0
77 ;Ignore disabled dialogs
78 I $P(DATA,U,3)=1 Q 0
79 ;Return dialog ien
80 Q DIEN
Note: See TracBrowser for help on using the repository browser.