PXRMDBL1 ; SLC/PJH - Reminder Dialog Generation. ;04/19/2000
;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
;
;Build Reminder Dialog
;---------------------
BUILD(REM,NAME,ARRAY) ;
;Lock the entire file
L +^PXRMD(801.41):30
E W !!,?5,"Another user is editing this file, try later" H 4 Q
;
N ACNT,ASUB,ATXT,CNT,DATA,DIEN,DNAME,DNODE,FGLOB,FITEM,FNODE,FSUB,FTYP
N INAME,MIEN,MSUB,PNAME,RESN,RNAME,RNODE,RPRE,RREQ,RSHORT,RSUB,RSUF
N TDMOD,TDPAR,TDX,TITEM,TPMOD,TPPAR,TPR,TSEQ,TSUB,TTYP
N TDHTXT,TDTXT,TPHTXT,TPTXT
N WPTXT,DSET,DSHORT
W !!,"Building dialog - "_NAME
;
;Upper and lower case transforms
N LOWER,UPPER
S LOWER="abcdefghijklmnopqrstuvwxyz"
S UPPER="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
;
;Build index of finding type to globals
N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
;
;Save name for use in building SET
S DSET(1)=NAME
;
;Get findings for this reminder
S FSUB=0,CNT=0
F S FSUB=$O(^PXD(811.9,REM,20,FSUB)) Q:'FSUB D
.S DATA=$G(^PXD(811.9,REM,20,FSUB,0)) Q:DATA=""
.;Single finding
.S RESN=$P(DATA,U)
.I $P(RESN,";",2)'="PXRMD(811.5," D FIND^PXRMDBL2(DATA) Q
.;Terms - 1st check finding item dialog file
.I $D(^PXRMD(801.43,"AC",RESN)) D Q:DIEN
..S DIEN=$$OK(RESN) Q:'DIEN
..;Create array used to build reminder dialog
..S CNT=CNT+1,ARRAY(CNT)=801.43_U_DIEN
..W !!,CNT,?5,"Finding item dialog "_$$FNAM(RESN)
.;Else process all the term findings
.S MIEN=$P($P(DATA,U),";") Q:'MIEN
.S MSUB=0
.F S MSUB=$O(^PXRMD(811.5,MIEN,20,MSUB)) Q:'MSUB D
..S DATA=$G(^PXRMD(811.5,MIEN,20,MSUB,0)) Q:DATA=""
..D FIND^PXRMDBL2(DATA)
;
;Update dialog file from FDA
D ^PXRMDBL3
;Unlock the file
L -^PXRMD(801.41)
Q
;
;Get Finding Item name
;---------------------
FNAM(FIND) ;
N DATA,GLOB,NAME,NODE
S NAME="Unknown"
S NODE=$O(^PXRMD(801.43,"AC",FIND,"")) Q:'NODE NAME
S DATA=$G(^PXRMD(801.43,NODE,0)) Q:DATA="" NAME
I $P(DATA,U)'="" S NAME=$P(DATA,U)
S GLOB=$P($P(FIND,U),";",2) S:GLOB]"" NAME=$G(DEF1(GLOB))_" - "_NAME
Q NAME
;
;Checks if an enabled finding item dialog exists
;-----------------------------------------------
OK(FIND) ;
N DATA,DIEN,DTYP,NODE
S NODE=$O(^PXRMD(801.43,"AC",FIND,"")) Q:'NODE 0
S DATA=$G(^PXRMD(801.43,NODE,0)) Q:DATA="" 0
;Ignore disabled entries
I $P(DATA,U,3) Q 0
;Ignore finding item dialogs no longer valid
S DIEN=$P(DATA,U,4) Q:DIEN="" 0
S DATA=$G(^PXRMD(801.41,DIEN,0)) Q:DATA="" 0
;Ignore disabled dialogs
I $P(DATA,U,3)=1 Q 0
;Return dialog ien
Q DIEN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDBL1 2544 printed Dec 13, 2024@01:43:32 Page 2
PXRMDBL1 ; SLC/PJH - Reminder Dialog Generation. ;04/19/2000
+1 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
+2 ;
+3 ;Build Reminder Dialog
+4 ;---------------------
BUILD(REM,NAME,ARRAY) ;
+1 ;Lock the entire file
+2 LOCK +^PXRMD(801.41):30
+3 IF '$TEST
WRITE !!,?5,"Another user is editing this file, try later"
HANG 4
QUIT
+4 ;
+5 NEW ACNT,ASUB,ATXT,CNT,DATA,DIEN,DNAME,DNODE,FGLOB,FITEM,FNODE,FSUB,FTYP
+6 NEW INAME,MIEN,MSUB,PNAME,RESN,RNAME,RNODE,RPRE,RREQ,RSHORT,RSUB,RSUF
+7 NEW TDMOD,TDPAR,TDX,TITEM,TPMOD,TPPAR,TPR,TSEQ,TSUB,TTYP
+8 NEW TDHTXT,TDTXT,TPHTXT,TPTXT
+9 NEW WPTXT,DSET,DSHORT
+10 WRITE !!,"Building dialog - "_NAME
+11 ;
+12 ;Upper and lower case transforms
+13 NEW LOWER,UPPER
+14 SET LOWER="abcdefghijklmnopqrstuvwxyz"
+15 SET UPPER="ABCDEFGHIJKLMNOPQRSTUVWXYZ"
+16 ;
+17 ;Build index of finding type to globals
+18 NEW DEF,DEF1,DEF2
DO DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
+19 ;
+20 ;Save name for use in building SET
+21 SET DSET(1)=NAME
+22 ;
+23 ;Get findings for this reminder
+24 SET FSUB=0
SET CNT=0
+25 FOR
SET FSUB=$ORDER(^PXD(811.9,REM,20,FSUB))
if 'FSUB
QUIT
Begin DoDot:1
+26 SET DATA=$GET(^PXD(811.9,REM,20,FSUB,0))
if DATA=""
QUIT
+27 ;Single finding
+28 SET RESN=$PIECE(DATA,U)
+29 IF $PIECE(RESN,";",2)'="PXRMD(811.5,"
DO FIND^PXRMDBL2(DATA)
QUIT
+30 ;Terms - 1st check finding item dialog file
+31 IF $DATA(^PXRMD(801.43,"AC",RESN))
Begin DoDot:2
+32 SET DIEN=$$OK(RESN)
if 'DIEN
QUIT
+33 ;Create array used to build reminder dialog
+34 SET CNT=CNT+1
SET ARRAY(CNT)=801.43_U_DIEN
+35 WRITE !!,CNT,?5,"Finding item dialog "_$$FNAM(RESN)
End DoDot:2
if DIEN
QUIT
+36 ;Else process all the term findings
+37 SET MIEN=$PIECE($PIECE(DATA,U),";")
if 'MIEN
QUIT
+38 SET MSUB=0
+39 FOR
SET MSUB=$ORDER(^PXRMD(811.5,MIEN,20,MSUB))
if 'MSUB
QUIT
Begin DoDot:2
+40 SET DATA=$GET(^PXRMD(811.5,MIEN,20,MSUB,0))
if DATA=""
QUIT
+41 DO FIND^PXRMDBL2(DATA)
End DoDot:2
End DoDot:1
+42 ;
+43 ;Update dialog file from FDA
+44 DO ^PXRMDBL3
+45 ;Unlock the file
+46 LOCK -^PXRMD(801.41)
+47 QUIT
+48 ;
+49 ;Get Finding Item name
+50 ;---------------------
FNAM(FIND) ;
+1 NEW DATA,GLOB,NAME,NODE
+2 SET NAME="Unknown"
+3 SET NODE=$ORDER(^PXRMD(801.43,"AC",FIND,""))
if 'NODE
QUIT NAME
+4 SET DATA=$GET(^PXRMD(801.43,NODE,0))
if DATA=""
QUIT NAME
+5 IF $PIECE(DATA,U)'=""
SET NAME=$PIECE(DATA,U)
+6 SET GLOB=$PIECE($PIECE(FIND,U),";",2)
if GLOB]""
SET NAME=$GET(DEF1(GLOB))_" - "_NAME
+7 QUIT NAME
+8 ;
+9 ;Checks if an enabled finding item dialog exists
+10 ;-----------------------------------------------
OK(FIND) ;
+1 NEW DATA,DIEN,DTYP,NODE
+2 SET NODE=$ORDER(^PXRMD(801.43,"AC",FIND,""))
if 'NODE
QUIT 0
+3 SET DATA=$GET(^PXRMD(801.43,NODE,0))
if DATA=""
QUIT 0
+4 ;Ignore disabled entries
+5 IF $PIECE(DATA,U,3)
QUIT 0
+6 ;Ignore finding item dialogs no longer valid
+7 SET DIEN=$PIECE(DATA,U,4)
if DIEN=""
QUIT 0
+8 SET DATA=$GET(^PXRMD(801.41,DIEN,0))
if DATA=""
QUIT 0
+9 ;Ignore disabled dialogs
+10 IF $PIECE(DATA,U,3)=1
QUIT 0
+11 ;Return dialog ien
+12 QUIT DIEN
