PXRMDLG ; SLC/PJH - Reminder Dialog Edit/Inquiry ;09/14/2009
;;2.0;CLINICAL REMINDERS;**12**;Feb 04, 2005;Build 73
;
;Labels called from list 'PXRM DIALOG LIST'
;
EXIT ;Exit code
D CLEAN^VALM10
D FULL^VALM1
S VALMBCK="Q"
K ^TMP("PXRMDLG",$J)
K ^TMP("PXRMDLG4",$J)
Q
;
HDR ; Header code
S VALMHDR(1)=PXRMHD
S VALMHDR(2)=""
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
Q
;
HELP ;Help code
N ORU,ORUPRMT,XQORM,PXRMTAG S PXRMTAG="GDLG"
D EN^VALM("PXRM DIALOG MAIN HELP")
Q
;
INIT ;Init
S VALMCNT=0
;Delete any sequence numbers without dialogs
D CHECK
;Load details of dialog
D BUILD(0)
Q
;
PEXIT ;PXRM DIALOG MENU protocol exit code
S VALMSG="+ Next Screen - Prev Screen ?? More Actions"
;Reset after page up or down
D XQORM
Q
;
;Other Subroutines
;
BUILD(INP) ;Build workfile (protocols PXRM DIALOG VIEW/LIST)
;
;Variable VIEW is set in the calling protocol
;
;0= DIALOG SUMMARY
;1= DIALOG DETAILS
;2= DIALOG TEXT
;3= PROGRESS NOTE TEXT
;4= INQUIRY (ALL FIELDS) - NO LISTMAN
;5= DIALOG OVERVIEW
;
N DNAM,DNAME,VIEW
S VIEW=INP,PXRMMODE=VIEW,VALMCNT=0,VALMBCK="R"
I VIEW=5 S VALMBG=1
K ^TMP("PXRMDLG",$J)
;Headers
S DNAM=$P($G(^PXRMD(801.41,PXRMDIEN,0)),U)
I $P($G(^PXRMD(801.41,PXRMDIEN,0)),U,3)>0 D
.S DNAM=DNAM_" (Disabled)"
S PXRMHD="DIALOG NAME: "_DNAM
I $P($G(^PXRMD(801.41,PXRMDIEN,0)),U,4)="R" D
.S PXRMHD="REMINDER "_PXRMHD
I $P($G(^PXRMD(801.41,PXRMDIEN,0)),U,4)="G" D
.S PXRMHD="DIALOG GROUP NAME: "_DNAM
I $P($G(^PXRMD(801.41,PXRMDIEN,100)),U)="N" D
.S PXRMHD=PXRMHD_" [NATIONAL] *LIMITED EDIT*"
D HDR
;
N DATA,DGRP,DHED,FGLOB,FIEN,FITEM,FNAME,FNUM,FTYP,RESULT,RESNM
N NATIONAL,OIEN,ONAME,ONUM,PDIS,PIEN,PNAME,PTXT,PTYP,RIEN,RNAME,SEQ,SUB
;Build list of finding items
N DEF,DEF1,DEF2 D DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
;Check if nationalreminder dialog
S NATIONAL=0 S:$P($G(^PXRMD(801.41,PXRMDIEN,100)),U)="N" NATIONAL=1
;Detail view of national dialogs allows only findings to be mapped
I VIEW=1,NATIONAL D ^PXRMDLG3,XQORM Q
;Build Listman array
D ARRAY(PXRMDIEN)
Q
;
ARRAY(DIEN) ;Build Dialog Display in list manager
;
N DNLOCK,NLINE,NODE,NSEL
S NLINE=0,NODE="PXRMDLG",NSEL=0
K ^TMP("PXRMDLG4",$J)
;
S DNLOCK=$P($G(^PXRMD(801.41,DIEN,100)),U,4)
;Group header
I $P($G(^PXRMD(801.41,DIEN,0)),U,4)="G" D
.D DLINE^PXRMDLG4(DIEN,"","",NODE)
;Other components
D DETAIL^PXRMDLG4(DIEN,"",VIEW,NODE)
;
;Headers
N HDR2
I VIEW=0 S HDR2="Dialog Summary" I $G(VALMBG)="" S VALMBG=1
I VIEW=1 S HDR2="Detailed Display"
I VIEW=2 S HDR2="Dialog Text"
I VIEW=3 S HDR2="Progress Note Text"
I VIEW=5 S HDR2="Dialog Overview"
;
;Create headings
D CHGCAP^VALM("HEADER1","Item Seq.")
D CHGCAP^VALM("HEADER2",HDR2)
D CHGCAP^VALM("HEADER3","")
;
S VALMCNT=NLINE
S ^TMP(NODE,$J,"VALMCNT")=VALMCNT
;
D XQORM
Q
;
CHECK ;Search for sequence numbers with no dialog pointer
N CNT,DA,DCNT,DEL,DELTMP,IEN,NODE,SCNT,SEQ,SEQTMP,SNUM
S IEN=PXRMDIEN,DEL="",(CNT,DA,SCNT)=0
F S DA=$O(^PXRMD(801.41,IEN,10,DA)) Q:+DA=0 S NODE=^PXRMD(801.41,IEN,10,DA,0) D
. I NODE'[U S CNT=CNT+1 S DELTMP(CNT)=DA
. I NODE[U S SCNT=SCNT+1 S SEQTMP($P($G(NODE),U),SCNT)=DA
;I CNT>0 D DELBLANK(IEN,.DELTMP)
S (SNUM,SEQ)=0
F S SEQ=$O(SEQTMP(SEQ)) Q:SEQ="" D
.S DCNT=0 F S SNUM=$O(SEQTMP(SEQ,SNUM)) Q:+SNUM=0 D
..S DCNT=DCNT+1 I DCNT>1 S DELTMP(DCNT)=SEQTMP(SEQ,SNUM) S DEL="Y"
;I DEL="Y" D DELBLANK(IEN,.DELTMP)
Q
;
DELBLANK(IEN,DELTMP) ;Delete dialog multiple entry if dialog missing
N NUM,DA
S DA(1)=IEN
S NUM=0
F S NUM=$O(DELTMP(NUM)) Q:NUM="" D
. S DA=DELTMP(NUM) Q:'DA
. S DIK="^PXRMD(801.41,"_DA(1)_",10,"
. D ^DIK
K DIK
Q
;
DESC(FIEN) ;Finding description
;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
;
LIT(INP) ;Find description for dialog type
Q:INP="G" "Dialog group: "
Q:INP="F" "Forced value: "
Q:INP="P" "Prompt: "
Q:INP="E" "Dialog element: "
Q "???"
;
REMD ;Reminder Details
N ARRAY,SUB
;Change listman headings
D CHGCAP^VALM("HEADER1","Reminder Inquiry")
D CHGCAP^VALM("HEADER2","")
D CHGCAP^VALM("HEADER3","")
;Check if dialog is linked to a reminder
I 'PXRMITEM D Q
.S ^TMP("PXRMDLG",$J,2,0)=" *This dialog is not linked to a reminder*"
;Build array using print template
D REMVAR^PXRMINQ(.ARRAY,PXRMITEM)
;Copy into Listman global
S SUB=0
F S SUB=$O(ARRAY(SUB)) Q:'SUB D
.S VALMCNT=SUB
.S ^TMP("PXRMDLG",$J,VALMCNT,0)=ARRAY(VALMCNT)
Q
;
SEL ;PXRM DIALOG SELECTION ITEM validation
N ERR,IEN,SEL
S VALMBCK="",SEL=+$P(XQORNOD(0),"=",2)
;Invalid selection
I ('SEL)!(SEL>VALMCNT)!('$D(@VALMAR@("IDX",SEL))) D Q
.W !,SEL_" is not an existing item number" H 2
;Valid selection
S IEN=$O(@VALMAR@("IDX",SEL,"")) Q:'IEN
;Copy/Delete/Edit dialog element
D IND^PXRMDEDI(IEN,SEL)
Q
;
XQORM ;Protocol Menu reset
S XQORM("#")=$O(^ORD(101,"B","PXRM DIALOG SELECTION ITEM",0))
S XQORM("#")=XQORM("#")_U_"1:"_VALMCNT
S XQORM("A")="Select Item: "
I PXRMGTYP="DLGE" D
.N FMENU
.S FMENU=$O(^ORD(101,"B","PXRM DIALOG GROUP MENU",0))_";ORD(101,"
.I FMENU S XQORM("HIJACK")=FMENU
Q
;
XHLP(CALL) ;General help text routine.
N HTEXT
N DIWF,DIWL,DIWR,IC,X
S DIWF="C75",DIWL=0,DIWR=75
;
I CALL=1 D
.S HTEXT(1)="Enter Yes to if you are adding a new sequence number or"
.S HTEXT(2)="dialog element to this reminder dialog."
K ^UTILITY($J,"W")
S IC=""
F S IC=$O(HTEXT(IC)) Q:IC="" D
. S X=HTEXT(IC)
. D ^DIWP
W !
S IC=0
F S IC=$O(^UTILITY($J,"W",0,IC)) Q:IC="" D
. W !,^UTILITY($J,"W",0,IC,0)
K ^UTILITY($J,"W")
W !
Q
PXRMDLG ; SLC/PJH - Reminder Dialog Edit/Inquiry ;09/14/2009
+1 ;;2.0;CLINICAL REMINDERS;**12**;Feb 04, 2005;Build 73
+2 ;
+3 ;Labels called from list 'PXRM DIALOG LIST'
+4 ;
EXIT ;Exit code
+1 DO CLEAN^VALM10
+2 DO FULL^VALM1
+3 SET VALMBCK="Q"
+4 KILL ^TMP("PXRMDLG",$JOB)
+5 KILL ^TMP("PXRMDLG4",$JOB)
+6 QUIT
+7 ;
HDR ; Header code
+1 SET VALMHDR(1)=PXRMHD
+2 SET VALMHDR(2)=""
+3 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+4 QUIT
+5 ;
HELP ;Help code
+1 NEW ORU,ORUPRMT,XQORM,PXRMTAG
SET PXRMTAG="GDLG"
+2 DO EN^VALM("PXRM DIALOG MAIN HELP")
+3 QUIT
+4 ;
INIT ;Init
+1 SET VALMCNT=0
+2 ;Delete any sequence numbers without dialogs
+3 DO CHECK
+4 ;Load details of dialog
+5 DO BUILD(0)
+6 QUIT
+7 ;
PEXIT ;PXRM DIALOG MENU protocol exit code
+1 SET VALMSG="+ Next Screen - Prev Screen ?? More Actions"
+2 ;Reset after page up or down
+3 DO XQORM
+4 QUIT
+5 ;
+6 ;Other Subroutines
+7 ;
BUILD(INP) ;Build workfile (protocols PXRM DIALOG VIEW/LIST)
+1 ;
+2 ;Variable VIEW is set in the calling protocol
+3 ;
+4 ;0= DIALOG SUMMARY
+5 ;1= DIALOG DETAILS
+6 ;2= DIALOG TEXT
+7 ;3= PROGRESS NOTE TEXT
+8 ;4= INQUIRY (ALL FIELDS) - NO LISTMAN
+9 ;5= DIALOG OVERVIEW
+10 ;
+11 NEW DNAM,DNAME,VIEW
+12 SET VIEW=INP
SET PXRMMODE=VIEW
SET VALMCNT=0
SET VALMBCK="R"
+13 IF VIEW=5
SET VALMBG=1
+14 KILL ^TMP("PXRMDLG",$JOB)
+15 ;Headers
+16 SET DNAM=$PIECE($GET(^PXRMD(801.41,PXRMDIEN,0)),U)
+17 IF $PIECE($GET(^PXRMD(801.41,PXRMDIEN,0)),U,3)>0
Begin DoDot:1
+18 SET DNAM=DNAM_" (Disabled)"
End DoDot:1
+19 SET PXRMHD="DIALOG NAME: "_DNAM
+20 IF $PIECE($GET(^PXRMD(801.41,PXRMDIEN,0)),U,4)="R"
Begin DoDot:1
+21 SET PXRMHD="REMINDER "_PXRMHD
End DoDot:1
+22 IF $PIECE($GET(^PXRMD(801.41,PXRMDIEN,0)),U,4)="G"
Begin DoDot:1
+23 SET PXRMHD="DIALOG GROUP NAME: "_DNAM
End DoDot:1
+24 IF $PIECE($GET(^PXRMD(801.41,PXRMDIEN,100)),U)="N"
Begin DoDot:1
+25 SET PXRMHD=PXRMHD_" [NATIONAL] *LIMITED EDIT*"
End DoDot:1
+26 DO HDR
+27 ;
+28 NEW DATA,DGRP,DHED,FGLOB,FIEN,FITEM,FNAME,FNUM,FTYP,RESULT,RESNM
+29 NEW NATIONAL,OIEN,ONAME,ONUM,PDIS,PIEN,PNAME,PTXT,PTYP,RIEN,RNAME,SEQ,SUB
+30 ;Build list of finding items
+31 NEW DEF,DEF1,DEF2
DO DEF^PXRMRUTL("811.902",.DEF,.DEF1,.DEF2)
+32 ;Check if nationalreminder dialog
+33 SET NATIONAL=0
IF $PIECE($GET(^PXRMD(801.41,PXRMDIEN,100)),U)="N"
SET NATIONAL=1
+34 ;Detail view of national dialogs allows only findings to be mapped
+35 IF VIEW=1
IF NATIONAL
DO ^PXRMDLG3
DO XQORM
QUIT
+36 ;Build Listman array
+37 DO ARRAY(PXRMDIEN)
+38 QUIT
+39 ;
ARRAY(DIEN) ;Build Dialog Display in list manager
+1 ;
+2 NEW DNLOCK,NLINE,NODE,NSEL
+3 SET NLINE=0
SET NODE="PXRMDLG"
SET NSEL=0
+4 KILL ^TMP("PXRMDLG4",$JOB)
+5 ;
+6 SET DNLOCK=$PIECE($GET(^PXRMD(801.41,DIEN,100)),U,4)
+7 ;Group header
+8 IF $PIECE($GET(^PXRMD(801.41,DIEN,0)),U,4)="G"
Begin DoDot:1
+9 DO DLINE^PXRMDLG4(DIEN,"","",NODE)
End DoDot:1
+10 ;Other components
+11 DO DETAIL^PXRMDLG4(DIEN,"",VIEW,NODE)
+12 ;
+13 ;Headers
+14 NEW HDR2
+15 IF VIEW=0
SET HDR2="Dialog Summary"
IF $GET(VALMBG)=""
SET VALMBG=1
+16 IF VIEW=1
SET HDR2="Detailed Display"
+17 IF VIEW=2
SET HDR2="Dialog Text"
+18 IF VIEW=3
SET HDR2="Progress Note Text"
+19 IF VIEW=5
SET HDR2="Dialog Overview"
+20 ;
+21 ;Create headings
+22 DO CHGCAP^VALM("HEADER1","Item Seq.")
+23 DO CHGCAP^VALM("HEADER2",HDR2)
+24 DO CHGCAP^VALM("HEADER3","")
+25 ;
+26 SET VALMCNT=NLINE
+27 SET ^TMP(NODE,$JOB,"VALMCNT")=VALMCNT
+28 ;
+29 DO XQORM
+30 QUIT
+31 ;
CHECK ;Search for sequence numbers with no dialog pointer
+1 NEW CNT,DA,DCNT,DEL,DELTMP,IEN,NODE,SCNT,SEQ,SEQTMP,SNUM
+2 SET IEN=PXRMDIEN
SET DEL=""
SET (CNT,DA,SCNT)=0
+3 FOR
SET DA=$ORDER(^PXRMD(801.41,IEN,10,DA))
IF +DA=0
QUIT
SET NODE=^PXRMD(801.41,IEN,10,DA,0)
Begin DoDot:1
+4 IF NODE'[U
SET CNT=CNT+1
SET DELTMP(CNT)=DA
+5 IF NODE[U
SET SCNT=SCNT+1
SET SEQTMP($PIECE($GET(NODE),U),SCNT)=DA
End DoDot:1
+6 ;I CNT>0 D DELBLANK(IEN,.DELTMP)
+7 SET (SNUM,SEQ)=0
+8 FOR
SET SEQ=$ORDER(SEQTMP(SEQ))
IF SEQ=""
QUIT
Begin DoDot:1
+9 SET DCNT=0
FOR
SET SNUM=$ORDER(SEQTMP(SEQ,SNUM))
IF +SNUM=0
QUIT
Begin DoDot:2
+10 SET DCNT=DCNT+1
IF DCNT>1
SET DELTMP(DCNT)=SEQTMP(SEQ,SNUM)
SET DEL="Y"
End DoDot:2
End DoDot:1
+11 ;I DEL="Y" D DELBLANK(IEN,.DELTMP)
+12 QUIT
+13 ;
DELBLANK(IEN,DELTMP) ;Delete dialog multiple entry if dialog missing
+1 NEW NUM,DA
+2 SET DA(1)=IEN
+3 SET NUM=0
+4 FOR
SET NUM=$ORDER(DELTMP(NUM))
IF NUM=""
QUIT
Begin DoDot:1
+5 SET DA=DELTMP(NUM)
IF 'DA
QUIT
+6 SET DIK="^PXRMD(801.41,"_DA(1)_",10,"
+7 DO ^DIK
End DoDot:1
+8 KILL DIK
+9 QUIT
+10 ;
DESC(FIEN) ;Finding description
+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 ;
LIT(INP) ;Find description for dialog type
+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 ;
REMD ;Reminder Details
+1 NEW ARRAY,SUB
+2 ;Change listman headings
+3 DO CHGCAP^VALM("HEADER1","Reminder Inquiry")
+4 DO CHGCAP^VALM("HEADER2","")
+5 DO CHGCAP^VALM("HEADER3","")
+6 ;Check if dialog is linked to a reminder
+7 IF 'PXRMITEM
Begin DoDot:1
+8 SET ^TMP("PXRMDLG",$JOB,2,0)=" *This dialog is not linked to a reminder*"
End DoDot:1
QUIT
+9 ;Build array using print template
+10 DO REMVAR^PXRMINQ(.ARRAY,PXRMITEM)
+11 ;Copy into Listman global
+12 SET SUB=0
+13 FOR
SET SUB=$ORDER(ARRAY(SUB))
IF 'SUB
QUIT
Begin DoDot:1
+14 SET VALMCNT=SUB
+15 SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=ARRAY(VALMCNT)
End DoDot:1
+16 QUIT
+17 ;
SEL ;PXRM DIALOG SELECTION ITEM validation
+1 NEW ERR,IEN,SEL
+2 SET VALMBCK=""
SET SEL=+$PIECE(XQORNOD(0),"=",2)
+3 ;Invalid selection
+4 IF ('SEL)!(SEL>VALMCNT)!('$DATA(@VALMAR@("IDX",SEL)))
Begin DoDot:1
+5 WRITE !,SEL_" is not an existing item number"
HANG 2
End DoDot:1
QUIT
+6 ;Valid selection
+7 SET IEN=$ORDER(@VALMAR@("IDX",SEL,""))
IF 'IEN
QUIT
+8 ;Copy/Delete/Edit dialog element
+9 DO IND^PXRMDEDI(IEN,SEL)
+10 QUIT
+11 ;
XQORM ;Protocol Menu reset
+1 SET XQORM("#")=$ORDER(^ORD(101,"B","PXRM DIALOG SELECTION ITEM",0))
+2 SET XQORM("#")=XQORM("#")_U_"1:"_VALMCNT
+3 SET XQORM("A")="Select Item: "
+4 IF PXRMGTYP="DLGE"
Begin DoDot:1
+5 NEW FMENU
+6 SET FMENU=$ORDER(^ORD(101,"B","PXRM DIALOG GROUP MENU",0))_";ORD(101,"
+7 IF FMENU
SET XQORM("HIJACK")=FMENU
End DoDot:1
+8 QUIT
+9 ;
XHLP(CALL) ;General help text routine.
+1 NEW HTEXT
+2 NEW DIWF,DIWL,DIWR,IC,X
+3 SET DIWF="C75"
SET DIWL=0
SET DIWR=75
+4 ;
+5 IF CALL=1
Begin DoDot:1
+6 SET HTEXT(1)="Enter Yes to if you are adding a new sequence number or"
+7 SET HTEXT(2)="dialog element to this reminder dialog."
End DoDot:1
+8 KILL ^UTILITY($JOB,"W")
+9 SET IC=""
+10 FOR
SET IC=$ORDER(HTEXT(IC))
IF IC=""
QUIT
Begin DoDot:1
+11 SET X=HTEXT(IC)
+12 DO ^DIWP
End DoDot:1
+13 WRITE !
+14 SET IC=0
+15 FOR
SET IC=$ORDER(^UTILITY($JOB,"W",0,IC))
IF IC=""
QUIT
Begin DoDot:1
+16 WRITE !,^UTILITY($JOB,"W",0,IC,0)
End DoDot:1
+17 KILL ^UTILITY($JOB,"W")
+18 WRITE !
+19 QUIT
