| 1 | PXRMDBL1 ; SLC/PJH - Reminder Dialog Generation. ;04/19/2000
|
|---|
| 2 | ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
|
|---|
| 3 | ;
|
|---|
| 4 | ;Build Reminder Dialog
|
|---|
| 5 | ;---------------------
|
|---|
| 6 | BUILD(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 | ;---------------------
|
|---|
| 57 | FNAM(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 | ;-----------------------------------------------
|
|---|
| 68 | OK(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
|
|---|
