PXRMDLG2 ; SLC/PJH - Reminder Dialog Edit/Inquiry ;06/02/2009
;;2.0;CLINICAL REMINDERS;**12**;Feb 04, 2005;Build 73
;
;Find description for dialog type
LIT(INP) ;
Q:INP="G" "Dialog group: "
Q:INP="F" "Forced value: "
Q:INP="P" "Prompt: "
Q:INP="E" "Dialog element: "
Q "???"
;
;Additional Findings
ADD(DIEN) ;
N FIND,FSUB,FTYP,FNAME,FNUM
S FSUB=0
F S FSUB=$O(^PXRMD(801.41,DIEN,3,FSUB)) Q:'FSUB D
.S FIND=$P($G(^PXRMD(801.41,DIEN,3,FSUB,0)),U) Q:FIND=""
.S FNAME="" D DESC(FIND) Q:FNAME=""
.S FNAME="Additional Finding: "_FNAME
.;Save additional finding name
.S VALMCNT=VALMCNT+1
.S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_FNAME
Q
;Finding description
DESC(FIEN) ;
;Determine finding type
S FGLOB=$P(FIEN,";",2) Q:FGLOB=""
S FITEM=$P(FIEN,";") Q:FITEM=""
;Diagnosis POV
I FGLOB["ICD9" D Q
.S FTYP="DIAGNOSIS",FGLOB=U_FGLOB_FITEM_",0)"
.S FNAME=$P($G(@FGLOB),U,3)_" ["_FITEM_"]"
;Procedure CPT
I FGLOB["ICPT" D Q
.S FTYP="PROCEDURE",FGLOB=U_FGLOB_FITEM_",0)"
.S FNAME=$P($G(@FGLOB),U,2)_" ["_FITEM_"]"
;Quick order
I FGLOB["ORD(101.41" D Q
.S FTYP="QUICK ORDER",FGLOB=U_FGLOB_FITEM_",0)"
.S FNAME=$P($G(@FGLOB),U,2)_" ["_FITEM_"]"
;Short name for finding type
S FTYP=$G(DEF1(FGLOB)) Q:FTYP=""
S FNUM=" ["_FTYP_"("_FITEM_")]"
;Long name
S FTYP=$G(DEF2(FTYP))
S FGLOB=U_FGLOB_FITEM_",0)"
S FNAME=$P($G(@FGLOB),U,1)
I FNAME="" S FNAME=$P($G(@FGLOB),U)
I FNAME]"" S FNAME=FNAME_FNUM Q
S FNAME=FITEM
Q
;
;Dialog Details (DD)
DETAIL(PIEN) ;
;Get prompt data
N DATA
S DATA=$G(^PXRMD(801.41,PIEN,0))
;Extract name, type and disabled
S PNAME=$P(DATA,U),PDIS=$P(DATA,U,3),PTYP=$P(DATA,U,4),PTYP=$$LIT(PTYP)
;Result (if any)
S RESULT=$P(DATA,U,15)
I RESULT S RESNM=$P($G(^PXRMD(801.41,RESULT,0)),U)
;Get Resolution/Finding details
S DATA=$G(^PXRMD(801.41,PIEN,1)),RIEN=$P(DATA,U,3),FIEN=$P(DATA,U,5)
;Resolution status name (assume this is a set)
S RNAME="???"
I RIEN S RNAME=$P($G(^PXRMD(801.9,RIEN,0)),U) S:RNAME="" RNAME="???"
;Set Default display values
S FNAME="???",FTYP="???",ONAME="???"
;For quick orders get the orderable item
I RNAME="ORDERED" D
.S FTYP="QUICK ORDER",FNAME="*QUICK ORDER MISSING*"
.S OIEN=$P($G(^PXRMD(801.41,PIEN,1)),U,7) Q:'OIEN
.S FGLOB="^ORD(101.43,"_OIEN_",0)"
.S ONAME=$P($G(@FGLOB),U)_" ["_OIEN_"]"
;Description of finding
D DESC(FIEN)
;
S RNAME="Resolution: "_RNAME
S FTYP="Finding type: "_FTYP
S FNAME="Finding item: "_FNAME
S VALMCNT=VALMCNT+1
S PTXT=$J(SEQ,3)_$J("",12)_PTYP_PNAME
S ^TMP("PXRMDLG",$J,VALMCNT,0)=PTXT_$J("",72-$L(PTXT))_$S(+PDIS>0:" (Disabled)",1:"")
S ^TMP("PXRMDLG",$J,"IDX",SEQ,PIEN)=""
;Save resolution
I ('DGRP),(FTYP'["TAXONOMY"),(FTYP'["MENTAL HEALTH") D
.I RNAME'["???" D
..S VALMCNT=VALMCNT+1
..S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_RNAME
.I FTYP["QUICK ORDER" D
..S VALMCNT=VALMCNT+1
..S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_"Orderable item: "_ONAME
I ('DGRP) D
.;Save finding type
.I FTYP'["???" D
..S VALMCNT=VALMCNT+1
..S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_FTYP
;Save finding name
I ('DGRP),(FNAME'["???") D
.S VALMCNT=VALMCNT+1
.S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_FNAME
;Additional Findings
I (FTYP'["TAXONOMY"),(FTYP'["MENTAL HEALTH") D ADD(PIEN)
;Result group/element (mental health)
I RESULT D
.;Save result details
.S VALMCNT=VALMCNT+1
.S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_"Result name: "_RESNM
;Get additional prompts/dialog group elements
D PROMPT^PXRMDLG1(PIEN,20,DHED,DGRP)
Q
;
;Group findings and prompts
GROUP(PIEN) ;
;Get prompt data
S DATA=$G(^PXRMD(801.41,PIEN,0))
;Extract name, type and disabled
S PNAME=$P(DATA,U),PDIS=$P(DATA,U,3),PTYP=$P(DATA,U,4),PTYP=$$LIT(PTYP)
;Result (if any)
S RESULT=$P(DATA,U,15)
I RESULT S RESNM=$P($G(^PXRMD(801.41,RESULT,0)),U)
;Get Resolution/Finding details
S DATA=$G(^PXRMD(801.41,PIEN,1)),RIEN=$P(DATA,U,3),FIEN=$P(DATA,U,5)
;Resolution status name (assume this is a set)
S RNAME="???"
I RIEN S RNAME=$P($G(^PXRMD(801.9,RIEN,0)),U) S:RNAME="" RNAME="???"
;Set Default display values
S FNAME="???",FTYP="???",ONAME="???"
;For quick orders get the orderable item
I RNAME="ORDERED" D
.S FTYP="QUICK ORDER",FNAME="*QUICK ORDER MISSING*"
.S OIEN=$P($G(^PXRMD(801.41,PIEN,1)),U,7) Q:'OIEN
.S FGLOB="^ORD(101.43,"_OIEN_",0)"
.S ONAME=$P($G(@FGLOB),U)_" ["_OIEN_"]"
;Description of finding
D DESC(FIEN)
;
S RNAME="Resolution: "_RNAME
S FTYP="Finding type: "_FTYP
S FNAME="Finding item: "_FNAME
;Save resolution
I (FTYP'["TAXONOMY"),(FTYP'["MENTAL HEALTH") D
.I RNAME'["???" D
..S VALMCNT=VALMCNT+1
..S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_RNAME
.I FTYP["QUICK ORDER" D
..S VALMCNT=VALMCNT+1
..S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_"Orderable item: "_ONAME
;Save finding type
I FTYP'["???" D
.S VALMCNT=VALMCNT+1
.S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_FTYP
;Save finding name
I (FNAME'["???") D
.S VALMCNT=VALMCNT+1
.S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",15)_FNAME
;Additional Findings
I (FTYP'["TAXONOMY"),(FTYP'["MENTAL HEALTH") D ADD(PIEN)
;Get additional prompts/dialog group elements
D PROMPT^PXRMDLG1(PIEN,20,"Additional prompts: ",0)
;Final line feed
S VALMCNT=VALMCNT+1
S ^TMP("PXRMDLG",$J,VALMCNT,0)=$J("",79)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDLG2 5373 printed Apr 09, 2024@20:48:20 Page 2
PXRMDLG2 ; SLC/PJH - Reminder Dialog Edit/Inquiry ;06/02/2009
+1 ;;2.0;CLINICAL REMINDERS;**12**;Feb 04, 2005;Build 73
+2 ;
+3 ;Find description for dialog type
LIT(INP) ;
+1 if INP="G"
QUIT "Dialog group: "
+2 if INP="F"
QUIT "Forced value: "
+3 if INP="P"
QUIT "Prompt: "
+4 if INP="E"
QUIT "Dialog element: "
+5 QUIT "???"
+6 ;
+7 ;Additional Findings
ADD(DIEN) ;
+1 NEW FIND,FSUB,FTYP,FNAME,FNUM
+2 SET FSUB=0
+3 FOR
SET FSUB=$ORDER(^PXRMD(801.41,DIEN,3,FSUB))
if 'FSUB
QUIT
Begin DoDot:1
+4 SET FIND=$PIECE($GET(^PXRMD(801.41,DIEN,3,FSUB,0)),U)
if FIND=""
QUIT
+5 SET FNAME=""
DO DESC(FIND)
if FNAME=""
QUIT
+6 SET FNAME="Additional Finding: "_FNAME
+7 ;Save additional finding name
+8 SET VALMCNT=VALMCNT+1
+9 SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=$JUSTIFY("",15)_FNAME
End DoDot:1
+10 QUIT
+11 ;Finding description
DESC(FIEN) ;
+1 ;Determine finding type
+2 SET FGLOB=$PIECE(FIEN,";",2)
if FGLOB=""
QUIT
+3 SET FITEM=$PIECE(FIEN,";")
if FITEM=""
QUIT
+4 ;Diagnosis POV
+5 IF FGLOB["ICD9"
Begin DoDot:1
+6 SET FTYP="DIAGNOSIS"
SET FGLOB=U_FGLOB_FITEM_",0)"
+7 SET FNAME=$PIECE($GET(@FGLOB),U,3)_" ["_FITEM_"]"
End DoDot:1
QUIT
+8 ;Procedure CPT
+9 IF FGLOB["ICPT"
Begin DoDot:1
+10 SET FTYP="PROCEDURE"
SET FGLOB=U_FGLOB_FITEM_",0)"
+11 SET FNAME=$PIECE($GET(@FGLOB),U,2)_" ["_FITEM_"]"
End DoDot:1
QUIT
+12 ;Quick order
+13 IF FGLOB["ORD(101.41"
Begin DoDot:1
+14 SET FTYP="QUICK ORDER"
SET FGLOB=U_FGLOB_FITEM_",0)"
+15 SET FNAME=$PIECE($GET(@FGLOB),U,2)_" ["_FITEM_"]"
End DoDot:1
QUIT
+16 ;Short name for finding type
+17 SET FTYP=$GET(DEF1(FGLOB))
if FTYP=""
QUIT
+18 SET FNUM=" ["_FTYP_"("_FITEM_")]"
+19 ;Long name
+20 SET FTYP=$GET(DEF2(FTYP))
+21 SET FGLOB=U_FGLOB_FITEM_",0)"
+22 SET FNAME=$PIECE($GET(@FGLOB),U,1)
+23 IF FNAME=""
SET FNAME=$PIECE($GET(@FGLOB),U)
+24 IF FNAME]""
SET FNAME=FNAME_FNUM
QUIT
+25 SET FNAME=FITEM
+26 QUIT
+27 ;
+28 ;Dialog Details (DD)
DETAIL(PIEN) ;
+1 ;Get prompt data
+2 NEW DATA
+3 SET DATA=$GET(^PXRMD(801.41,PIEN,0))
+4 ;Extract name, type and disabled
+5 SET PNAME=$PIECE(DATA,U)
SET PDIS=$PIECE(DATA,U,3)
SET PTYP=$PIECE(DATA,U,4)
SET PTYP=$$LIT(PTYP)
+6 ;Result (if any)
+7 SET RESULT=$PIECE(DATA,U,15)
+8 IF RESULT
SET RESNM=$PIECE($GET(^PXRMD(801.41,RESULT,0)),U)
+9 ;Get Resolution/Finding details
+10 SET DATA=$GET(^PXRMD(801.41,PIEN,1))
SET RIEN=$PIECE(DATA,U,3)
SET FIEN=$PIECE(DATA,U,5)
+11 ;Resolution status name (assume this is a set)
+12 SET RNAME="???"
+13 IF RIEN
SET RNAME=$PIECE($GET(^PXRMD(801.9,RIEN,0)),U)
if RNAME=""
SET RNAME="???"
+14 ;Set Default display values
+15 SET FNAME="???"
SET FTYP="???"
SET ONAME="???"
+16 ;For quick orders get the orderable item
+17 IF RNAME="ORDERED"
Begin DoDot:1
+18 SET FTYP="QUICK ORDER"
SET FNAME="*QUICK ORDER MISSING*"
+19 SET OIEN=$PIECE($GET(^PXRMD(801.41,PIEN,1)),U,7)
if 'OIEN
QUIT
+20 SET FGLOB="^ORD(101.43,"_OIEN_",0)"
+21 SET ONAME=$PIECE($GET(@FGLOB),U)_" ["_OIEN_"]"
End DoDot:1
+22 ;Description of finding
+23 DO DESC(FIEN)
+24 ;
+25 SET RNAME="Resolution: "_RNAME
+26 SET FTYP="Finding type: "_FTYP
+27 SET FNAME="Finding item: "_FNAME
+28 SET VALMCNT=VALMCNT+1
+29 SET PTXT=$JUSTIFY(SEQ,3)_$JUSTIFY("",12)_PTYP_PNAME
+30 SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=PTXT_$JUSTIFY("",72-$LENGTH(PTXT))_$SELECT(+PDIS>0:" (Disabled)",1:"")
+31 SET ^TMP("PXRMDLG",$JOB,"IDX",SEQ,PIEN)=""
+32 ;Save resolution
+33 IF ('DGRP)
IF (FTYP'["TAXONOMY")
IF (FTYP'["MENTAL HEALTH")
Begin DoDot:1
+34 IF RNAME'["???"
Begin DoDot:2
+35 SET VALMCNT=VALMCNT+1
+36 SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=$JUSTIFY("",15)_RNAME
End DoDot:2
+37 IF FTYP["QUICK ORDER"
Begin DoDot:2
+38 SET VALMCNT=VALMCNT+1
+39 SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=$JUSTIFY("",15)_"Orderable item: "_ONAME
End DoDot:2
End DoDot:1
+40 IF ('DGRP)
Begin DoDot:1
+41 ;Save finding type
+42 IF FTYP'["???"
Begin DoDot:2
+43 SET VALMCNT=VALMCNT+1
+44 SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=$JUSTIFY("",15)_FTYP
End DoDot:2
End DoDot:1
+45 ;Save finding name
+46 IF ('DGRP)
IF (FNAME'["???")
Begin DoDot:1
+47 SET VALMCNT=VALMCNT+1
+48 SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=$JUSTIFY("",15)_FNAME
End DoDot:1
+49 ;Additional Findings
+50 IF (FTYP'["TAXONOMY")
IF (FTYP'["MENTAL HEALTH")
DO ADD(PIEN)
+51 ;Result group/element (mental health)
+52 IF RESULT
Begin DoDot:1
+53 ;Save result details
+54 SET VALMCNT=VALMCNT+1
+55 SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=$JUSTIFY("",15)_"Result name: "_RESNM
End DoDot:1
+56 ;Get additional prompts/dialog group elements
+57 DO PROMPT^PXRMDLG1(PIEN,20,DHED,DGRP)
+58 QUIT
+59 ;
+60 ;Group findings and prompts
GROUP(PIEN) ;
+1 ;Get prompt data
+2 SET DATA=$GET(^PXRMD(801.41,PIEN,0))
+3 ;Extract name, type and disabled
+4 SET PNAME=$PIECE(DATA,U)
SET PDIS=$PIECE(DATA,U,3)
SET PTYP=$PIECE(DATA,U,4)
SET PTYP=$$LIT(PTYP)
+5 ;Result (if any)
+6 SET RESULT=$PIECE(DATA,U,15)
+7 IF RESULT
SET RESNM=$PIECE($GET(^PXRMD(801.41,RESULT,0)),U)
+8 ;Get Resolution/Finding details
+9 SET DATA=$GET(^PXRMD(801.41,PIEN,1))
SET RIEN=$PIECE(DATA,U,3)
SET FIEN=$PIECE(DATA,U,5)
+10 ;Resolution status name (assume this is a set)
+11 SET RNAME="???"
+12 IF RIEN
SET RNAME=$PIECE($GET(^PXRMD(801.9,RIEN,0)),U)
if RNAME=""
SET RNAME="???"
+13 ;Set Default display values
+14 SET FNAME="???"
SET FTYP="???"
SET ONAME="???"
+15 ;For quick orders get the orderable item
+16 IF RNAME="ORDERED"
Begin DoDot:1
+17 SET FTYP="QUICK ORDER"
SET FNAME="*QUICK ORDER MISSING*"
+18 SET OIEN=$PIECE($GET(^PXRMD(801.41,PIEN,1)),U,7)
if 'OIEN
QUIT
+19 SET FGLOB="^ORD(101.43,"_OIEN_",0)"
+20 SET ONAME=$PIECE($GET(@FGLOB),U)_" ["_OIEN_"]"
End DoDot:1
+21 ;Description of finding
+22 DO DESC(FIEN)
+23 ;
+24 SET RNAME="Resolution: "_RNAME
+25 SET FTYP="Finding type: "_FTYP
+26 SET FNAME="Finding item: "_FNAME
+27 ;Save resolution
+28 IF (FTYP'["TAXONOMY")
IF (FTYP'["MENTAL HEALTH")
Begin DoDot:1
+29 IF RNAME'["???"
Begin DoDot:2
+30 SET VALMCNT=VALMCNT+1
+31 SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=$JUSTIFY("",15)_RNAME
End DoDot:2
+32 IF FTYP["QUICK ORDER"
Begin DoDot:2
+33 SET VALMCNT=VALMCNT+1
+34 SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=$JUSTIFY("",15)_"Orderable item: "_ONAME
End DoDot:2
End DoDot:1
+35 ;Save finding type
+36 IF FTYP'["???"
Begin DoDot:1
+37 SET VALMCNT=VALMCNT+1
+38 SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=$JUSTIFY("",15)_FTYP
End DoDot:1
+39 ;Save finding name
+40 IF (FNAME'["???")
Begin DoDot:1
+41 SET VALMCNT=VALMCNT+1
+42 SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=$JUSTIFY("",15)_FNAME
End DoDot:1
+43 ;Additional Findings
+44 IF (FTYP'["TAXONOMY")
IF (FTYP'["MENTAL HEALTH")
DO ADD(PIEN)
+45 ;Get additional prompts/dialog group elements
+46 DO PROMPT^PXRMDLG1(PIEN,20,"Additional prompts: ",0)
+47 ;Final line feed
+48 SET VALMCNT=VALMCNT+1
+49 SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=$JUSTIFY("",79)
+50 QUIT
