PXRMDLG4 ; SLC/PJH - Reminder Dialog Edit/Inquiry ;08/20/2012
;;2.0;CLINICAL REMINDERS;**4,6,12,16,26**;Feb 04, 2005;Build 404
;
WP(SUB,SUB1,WIDTH,SEQ,VALMCNT) ;Format WP text
N DIWF,DIWL,DIWR,IC,TEXT,X,TXTCNT,DTXT,CNT,SUB2
S (CNT,SUB2,TXTCNT)=0
F S SUB2=$O(^PXRMD(801.41,SUB,SUB1,SUB2)) Q:'SUB2 D
.S TXTCNT=TXTCNT+1,DTXT(TXTCNT)=$G(^PXRMD(801.41,SUB,SUB1,SUB2,0))
.S DTXT(TXTCNT)=$$STRREP^PXRMUTIL($G(DTXT(TXTCNT)),"<br>","\\")
I TXTCNT>0 D
.N OUTPUT,NLINES
.S NLINES=0 D FORMAT^PXRMTEXT(1,WIDTH,TXTCNT,.DTXT,.NLINES,.OUTPUT)
.I NLINES>0 K DTXT M DTXT=OUTPUT
S CNT=0
F S CNT=$O(DTXT(CNT)) Q:CNT="" D
.S TEXT=$G(DTXT(CNT)),VALMCNT=VALMCNT+1
.S ^TMP(NODE,$J,VALMCNT,0)=SEQ_TEXT,SEQ=$J("",$L(SEQ))
Q
;
ADD ;PXRM DIALOG ADD ELEMENT validation
N ANS,DTOUT,DUOUT,LIT,LOCK,Y,PIEN,ERR,IEN,NATIONAL,SEQ
W IORESET
S VALMBCK="R",NATIONAL=0
I $P($G(^PXRMD(801.41,PXRMDIEN,100)),U)="N" S NATIONAL=1
S LOCK=$P($G(^PXRMD(801.41,PXRMDIEN,100)),U,4)
I NATIONAL,'($G(PXRMINST)=1)&(DUZ(0)="@"),$G(LOCK)'=1 D Q
.W !,"Elements may not be added to national reminder dialogs" H 2
;
F D SEQ(.SEQ,.PIEN) Q:$D(DUOUT)!$D(DTOUT) Q:SEQ
Q:$D(DUOUT)!$D(DTOUT)
;
;Check if sequence number is OK
I $G(PIEN)="" Q
S ANS="N" D ASK^PXRMDLG5(.ANS,PIEN) Q:$D(DUOUT)!$D(DTOUT)!($G(ANS)="N")
;
;Select a dialog element to add to parent dialog (PIEN)
;PIEN may be dialog or a group within the dialog
D ESEL^PXRMDEDT(PIEN,SEQ)
;Rebuild workfile
D BUILD^PXRMDLG(PXRMMODE)
Q
;
FADD(DIEN,FTAB,VIEW,NLINE) ;Additional Findings
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 FDESC(FIND) Q:FNAME=""
.;
.;Save additional finding name
.S FOUND=1 D FSAVE(2,FNAME,FTYP,FTAB,FIND)
.I VIEW=2,FIND["PXD(811.2," D TAXDISP^PXRMDTAX(FIND,"",DIEN,.NLINE,NODE,1,0)
Q
;
DETAIL(DIEN,LEV,VIEW,NODE) ;;Build listman global for all components
N DDATA,DDLG,DEND,DCIEN,DNAM,DSEQ,DSTRT,IND,JND,DSUB
S DSEQ=0
;
;Get each sequence number
F S DSEQ=$O(^PXRMD(801.41,DIEN,10,"B",DSEQ)) Q:'DSEQ D
.;Determine subscript
.S DSUB=$O(^PXRMD(801.41,DIEN,10,"B",DSEQ,"")) Q:'DSUB
.;Get ien of prompt/component
.S DCIEN=$P($G(^PXRMD(801.41,DIEN,10,DSUB,0)),U,2) Q:'DCIEN
.I "PF"[$P($G(^PXRMD(801.41,DCIEN,0)),U,4) D Q
..S ^TMP("PXRMDLG4",$J,"IEN",NSEL)=DIEN_U_DSEQ
..S ^TMP("PXRMDLG4",$J,"SEQ",LEV_DSEQ)=DCIEN
.;Save line in workfile
.D DLINE(DCIEN,LEV,DSEQ,NODE)
.;Build pointers back to parent
.I VIEW'=4 D
..S ^TMP("PXRMDLG4",$J,"IEN",NSEL)=DIEN_U_DSEQ
..S ^TMP("PXRMDLG4",$J,"SEQ",LEV_DSEQ)=DCIEN
.;Process any sub-components
.I VIEW<5 D DETAIL(DCIEN,LEV_DSEQ_".",VIEW,NODE)
Q
;
DLINE(DIEN,LEV,DSEQ,NODE) ;Save individual component details
N CNT,DBOX,DCAP,DDIS,DMULT,DSUPP,DSHOW,DTYP,DTXT
N IC,RESNM,RESULT,RIEN,RNAME,RCNT
;Dialog name
S DDATA=$G(^PXRMD(801.41,DIEN,0)),DNAM=$P(DDATA,U) Q:DNAM=""
;Check if standard PXRM prompt
I $$PXRM^PXRMEXID(DNAM) Q
;Dialog Type and Disabled
S DDIS=$P(DDATA,U,3),DTYP=$P(DDATA,U,4)
S DTYP=$S(DTYP="G":"Group",1:"Element"),DNAM=DTYP_": "_DNAM
I VIEW=5 S DNAM=DNAM
;Resolution type and name
S RNAME="",RIEN=$P($G(^PXRMD(801.41,DIEN,1)),U,3)
I RIEN S RNAME=$P($G(^PXRMD(801.9,RIEN,0)),U)
;
;Group fields
I DTYP="Group" D
.S DGRP=1,DTXT=$P(DDATA,U,5),DCAP=" [group caption]"
.I DTXT="" S DCAP=""
.I DTXT]"" S DCAP=DTXT_" "_DCAP
.S DBOX=$S($P(DDATA,U,6)="Y":"BOX",1:"NO BOX")
.S DSUPP=$S($P(DDATA,U,11):"SUPPRESS",1:"NO SUPPRESS")
.S DSHOW=$S($P(DDATA,U,10):"HIDE",1:"SHOW")
.S DMULT=$P(DDATA,U,9)
.S DMULT=$S(DMULT=1:"ONE ONLY",DMULT=2:"ONE OR MORE",DMULT=3:"NONE OR ONE",DMULT=4:"ALL REQUIRED",1:"NO SELECTION")
;
N DPTX,DTXT,EXIST,ITEM,TEMP,SEP,SEQ,TAB,ALTLEN
S NSEL=NSEL+1,NLINE=NLINE+1,ITEM=NSEL,SEP=$E(LEV,$L(LEV)),SEQ=LEV_DSEQ
;Suppress Item numbers for INQ options
I VIEW=4 S ITEM=""
;Otherwise display Item, Sequence and Dialog Name
S TEMP=$J(ITEM,4)_$J("",3)_SEQ,TAB=$L(TEMP)+2
S CNT=0 F IC=1:1 Q:'$P(SEQ,".",IC) S:$P(SEQ,".",IC)<10 CNT=CNT+1
S TAB=TAB+CNT
;
S ALTLEN=$L(TEMP)
;Display dialog name
S TEMP=TEMP_$J("",2+CNT)_DNAM
;Add disabled if present
I +DDIS>0 S TEMP=TEMP_" (Disabled)"
;
S ^TMP(NODE,$J,NLINE,0)=TEMP
;check for alternate dialog element/group
I VIEW<2!(VIEW>4) D
.I $D(^PXRMD(801.41,DIEN,49))>0 D ALT^PXRMDLG5(DIEN,LEV,DSEQ,NODE,VIEW,.NLINE,CNT,ALTLEN)
;
;Dialog Text or P/N Text
I (VIEW=2)!(VIEW=3)!(VIEW=4) D
.N DGBEG,DGSUB,TSUB
.S DGSUB=0,TSUB=$$TSUB^PXRMDLG1(DIEN,VIEW)
.I VIEW=4 S DGBEG=$J("",TAB)_"Text: "
.I VIEW'=4 S DGBEG=$J("",5+$L(SEQ)+CNT+$L(DTYP))_"Text: "
.D WP(DIEN,TSUB,65,.DGBEG,.NLINE)
.I DTYP="Group" D
..S TEMP=DGBEG_"["_DBOX_", "_DSUPP_", "_DSHOW_", "_DMULT_"]"
..S NLINE=NLINE+1,^TMP(NODE,$J,NLINE,0)=TEMP
;
;Set up selection index
S ^TMP(NODE,$J,"IDX",NSEL,DIEN)=""
;Insert finding items
I (VIEW=1)!(VIEW=4),("Element;Group"[DTYP) D
.N DSUB,FDATA,FILENUM,FLIT,FLONG,FNAME,FOUND,FREP,FTYP,TEMP
.;Findings
.S FNAME="",FOUND=0
.D FDESC($P($G(^PXRMD(801.41,DIEN,1)),U,5))
.I FNAME'="" S FOUND=1 D FSAVE(1,FNAME,FTYP,TAB)
.;Resolution
.I RNAME]"" D
..S TEMP=$J("",TAB)_"Resolution: "_RNAME
..S NLINE=NLINE+1,^TMP(NODE,$J,NLINE,0)=TEMP
.;Result Group
.I VIEW=4 D
..S RCNT=0 F S RCNT=$O(^PXRMD(801.41,DIEN,51,RCNT)) Q:RCNT'>0 D
...S RESULT=$P($G(^PXRMD(801.41,DIEN,51,RCNT,0)),U)
...S RESNM=$P($G(^PXRMD(801.41,RESULT,0)),U) Q:RESNM=""
...S TEMP=$J("",TAB)_"Result Group: "_RESNM
...S NLINE=NLINE+1,^TMP(NODE,$J,NLINE,0)=TEMP
.;Additional findings
.D FADD(DIEN,TAB,VIEW,.NLINE)
;Get additional prompts
I VIEW=2 D
.S FIEN=$P($G(^PXRMD(801.41,DIEN,1)),U,5)
.I $G(FIEN)["PXD(811.2," D TAXDISP^PXRMDTAX(FIEN,DSEQ,DIEN,.NLINE,NODE,0,0)
.D FADD(DIEN,TAB,VIEW,.NLINE)
I VIEW,VIEW<5,"Element;Group"[DTYP D PROMPT(DIEN,TAB,"Prompts: ",VIEW)
;
I VIEW=4,$D(^PXRMD(801.41,DIEN,49))>0 D ALT^PXRMDLG5(DIEN,LEV,DSEQ,NODE,VIEW,.NLINE,CNT,ALTLEN)
S NLINE=NLINE+1
S ^TMP(NODE,$J,NLINE,0)=$J("",79)
Q
;
FDESC(FIEN) ;Finding description
N FGLOB,FITEM,FNUM
S FGLOB=$P(FIEN,";",2) Q:FGLOB=""
S FITEM=$P(FIEN,";") Q:FITEM=""
S FNUM=" ["_FITEM_"]"
I FGLOB["ICD9" D Q
.S FTYP="DIAGNOSIS",FGLOB=U_FGLOB_FITEM_",0)"
.S FNAME=$P($G(@FGLOB),U,3)_FNUM
I FGLOB["WV" D Q
.S FTYP="WH NOTIFICATION PURPOSE",FGLOB=U_FGLOB_FITEM_",0)"
.S FNAME=$P($G(@FGLOB),U)_FNUM
I FGLOB["ICPT" D Q
.S FTYP="PROCEDURE",FGLOB=U_FGLOB_FITEM_",0)"
.S FNAME=$P($G(@FGLOB),U,2)_FNUM
I FGLOB["ORD(101.41" D Q
.S FTYP="QUICK ORDER",FGLOB=U_FGLOB_FITEM_",0)"
.S FNAME=$P($G(@FGLOB),U,2)_FNUM
;Short name for finding type
S FTYP=$G(DEF1(FGLOB)) Q:FTYP=""
;Long name
S FTYP=$G(DEF2(FTYP))
S FGLOB=U_FGLOB_FITEM_",0)"
S FNAME=$P($G(@FGLOB),U,1)_FNUM
I FNAME="" S FNAME=$P($G(@FGLOB),U)_FNUM
I FNAME="" S FNAME=FITEM
Q
;
FSAVE(DSUB,FNAME,FTYP,FTAB,FIEN) ;Save finding details
N IND,FMTSTR,NL,OUTPUT,TEMP,TEXT
I DSUB>1 D
. S FMTSTR=FTAB_"R^13L1^"_(65-FTAB)_"L"
. S TEXT=U_"Add. Finding:"
I DSUB=1 D
. S FMTSTR=FTAB_"R^8L1^"_(70-FTAB)_"L"
. S TEXT=U_"Finding:"
S TEXT=TEXT_U_FNAME_" ("_FTYP_")"
D COLFMT^PXRMTEXT(FMTSTR,TEXT," ",.NL,.OUTPUT)
F IND=1:1:NL D
. S NLINE=NLINE+1
. S ^TMP(NODE,$J,NLINE,0)=OUTPUT(IND)
Q
;
PROMPT(IEN,TAB,TEXT,VIEW) ;additional prompts in the dialog file
N DATA,DDIS,DGSEQ,DSUB,DTITLE,DTXT,DTYP,SEQ,SUB
S SEQ=0
F S SEQ=$O(^PXRMD(801.41,IEN,10,"B",SEQ)) Q:'SEQ D
.S SUB=$O(^PXRMD(801.41,IEN,10,"B",SEQ,"")) Q:'SUB
.S DSUB=$P($G(^PXRMD(801.41,IEN,10,SUB,0)),U,2) Q:'DSUB
.S DATA=$G(^PXRMD(801.41,DSUB,0)) Q:DATA=""
.S DNAME=$P(DATA,U),DDIS=$P(DATA,U,3),DTYP=$P(DATA,U,4)
.I "PF"'[DTYP Q
.I DTYP="F" S DNAME=DNAME_" (forced value)"
.I DTYP="P",(VIEW=2)!(VIEW=3) D
..;Override prompt caption
..S DTITLE=$P($G(^PXRMD(801.41,IEN,10,SUB,0)),U,6)
..I DTITLE="" S DTITLE=$P($G(^PXRMD(801.41,DSUB,2)),U,4)
..S DNAME=DTITLE
.S DNAME=$J("",TAB)_TEXT_DNAME
.S:+DDIS>0 DNAME=DNAME_" (Disabled)"
.S NLINE=NLINE+1
.S ^TMP(NODE,$J,NLINE,0)=DNAME
.S TEXT=$J("",$L(TEXT))
Q
;
SEQ(SEQ,PIEN) ;Select sequence number to add
N X,Y,TEXT,DIR
K DIROUT,DIRUT,DTOUT,DUOUT
S SEQ=0
S DIR(0)="FA0;1;30"
S DIR("A")="Enter a new SEQUENCE NUMBER: "
S DIR("?")="Enter new sequence number. For detailed help type ??"
S DIR("??")=U_"D HELP^PXRMDLG4(1)"
D ^DIR K DIR
I $D(DIROUT) S DTOUT=1
I $D(DTOUT)!($D(DUOUT)) Q
;
;Check that sequence number is new
I $D(^TMP("PXRMDLG4",$J,"SEQ",X)) D Q
.W !,"Sequence number "_X_" already in use."
;
;Check that the parent is a group or reminder dialog
I X["." D Q:X=""
.N CLASS,SUB
.;Sequence number of parent
.S SUB=$P(X,".",1,$L(X,".")-1)
.I $G(SUB)=""!($G(SUB)=0) W !,"Invalid sequence number. A sequence number cannot be less then 1" H 2 Q
.;Get IEN of parent dialog or group
.S PIEN=$G(^TMP("PXRMDLG4",$J,"SEQ",SUB))
.;Validate sequence number
.I 'PIEN W !,"Sequence number is not part of an existing group." S X="" Q
.;Validate that the parent is a group or reminder dialog
.I "RG"'[$P($G(^PXRMD(801.41,PIEN,0)),U,4) D S X="" Q
..W !,"New sequences can only be added to groups or reminder dialogs"
.;Disallow adding elements to national dialogs or groups
.I $P($G(^PXMRD(801.41,PIEN,100)),U)="N" D Q:X=""
..Q:(DUZ(0)="@")&($G(PXRMINST)=1)
..W !,"Elements cannot be added to a national group" S X=""
;
;If adding to top level parent ien is reminder dialog
I X?.N S PIEN=PXRMDIEN
;
S SEQ=$P(X,".",$L(X,"."))
Q
;
;
HELP(CALL) ;General help text routine.
N HTEXT
N DIWF,DIWL,DIWR,IC
S DIWF="C75",DIWL=0,DIWR=75
;
I CALL=1 D
.S HTEXT(1)="Sequence numbers can be added at any level. Specify the full"
.S HTEXT(2)="number for the level required (e.g. 15.10.20)."
;
D HELP^PXRMEUT(.HTEXT)
Q
;
PXRMDLG4 ; SLC/PJH - Reminder Dialog Edit/Inquiry ;08/20/2012
+1 ;;2.0;CLINICAL REMINDERS;**4,6,12,16,26**;Feb 04, 2005;Build 404
+2 ;
WP(SUB,SUB1,WIDTH,SEQ,VALMCNT) ;Format WP text
+1 NEW DIWF,DIWL,DIWR,IC,TEXT,X,TXTCNT,DTXT,CNT,SUB2
+2 SET (CNT,SUB2,TXTCNT)=0
+3 FOR
SET SUB2=$ORDER(^PXRMD(801.41,SUB,SUB1,SUB2))
IF 'SUB2
QUIT
Begin DoDot:1
+4 SET TXTCNT=TXTCNT+1
SET DTXT(TXTCNT)=$GET(^PXRMD(801.41,SUB,SUB1,SUB2,0))
+5 SET DTXT(TXTCNT)=$$STRREP^PXRMUTIL($GET(DTXT(TXTCNT)),"<br>","\\")
End DoDot:1
+6 IF TXTCNT>0
Begin DoDot:1
+7 NEW OUTPUT,NLINES
+8 SET NLINES=0
DO FORMAT^PXRMTEXT(1,WIDTH,TXTCNT,.DTXT,.NLINES,.OUTPUT)
+9 IF NLINES>0
KILL DTXT
MERGE DTXT=OUTPUT
End DoDot:1
+10 SET CNT=0
+11 FOR
SET CNT=$ORDER(DTXT(CNT))
IF CNT=""
QUIT
Begin DoDot:1
+12 SET TEXT=$GET(DTXT(CNT))
SET VALMCNT=VALMCNT+1
+13 SET ^TMP(NODE,$JOB,VALMCNT,0)=SEQ_TEXT
SET SEQ=$JUSTIFY("",$LENGTH(SEQ))
End DoDot:1
+14 QUIT
+15 ;
ADD ;PXRM DIALOG ADD ELEMENT validation
+1 NEW ANS,DTOUT,DUOUT,LIT,LOCK,Y,PIEN,ERR,IEN,NATIONAL,SEQ
+2 WRITE IORESET
+3 SET VALMBCK="R"
SET NATIONAL=0
+4 IF $PIECE($GET(^PXRMD(801.41,PXRMDIEN,100)),U)="N"
SET NATIONAL=1
+5 SET LOCK=$PIECE($GET(^PXRMD(801.41,PXRMDIEN,100)),U,4)
+6 IF NATIONAL
IF '($GET(PXRMINST)=1)&(DUZ(0)="@")
IF $GET(LOCK)'=1
Begin DoDot:1
+7 WRITE !,"Elements may not be added to national reminder dialogs"
HANG 2
End DoDot:1
QUIT
+8 ;
+9 FOR
DO SEQ(.SEQ,.PIEN)
IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
IF SEQ
QUIT
+10 IF $DATA(DUOUT)!$DATA(DTOUT)
QUIT
+11 ;
+12 ;Check if sequence number is OK
+13 IF $GET(PIEN)=""
QUIT
+14 SET ANS="N"
DO ASK^PXRMDLG5(.ANS,PIEN)
IF $DATA(DUOUT)!$DATA(DTOUT)!($GET(ANS)="N")
QUIT
+15 ;
+16 ;Select a dialog element to add to parent dialog (PIEN)
+17 ;PIEN may be dialog or a group within the dialog
+18 DO ESEL^PXRMDEDT(PIEN,SEQ)
+19 ;Rebuild workfile
+20 DO BUILD^PXRMDLG(PXRMMODE)
+21 QUIT
+22 ;
FADD(DIEN,FTAB,VIEW,NLINE) ;Additional Findings
+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 FDESC(FIND)
IF FNAME=""
QUIT
+6 ;
+7 ;Save additional finding name
+8 SET FOUND=1
DO FSAVE(2,FNAME,FTYP,FTAB,FIND)
+9 IF VIEW=2
IF FIND["PXD(811.2,"
DO TAXDISP^PXRMDTAX(FIND,"",DIEN,.NLINE,NODE,1,0)
End DoDot:1
+10 QUIT
+11 ;
DETAIL(DIEN,LEV,VIEW,NODE) ;;Build listman global for all components
+1 NEW DDATA,DDLG,DEND,DCIEN,DNAM,DSEQ,DSTRT,IND,JND,DSUB
+2 SET DSEQ=0
+3 ;
+4 ;Get each sequence number
+5 FOR
SET DSEQ=$ORDER(^PXRMD(801.41,DIEN,10,"B",DSEQ))
IF 'DSEQ
QUIT
Begin DoDot:1
+6 ;Determine subscript
+7 SET DSUB=$ORDER(^PXRMD(801.41,DIEN,10,"B",DSEQ,""))
IF 'DSUB
QUIT
+8 ;Get ien of prompt/component
+9 SET DCIEN=$PIECE($GET(^PXRMD(801.41,DIEN,10,DSUB,0)),U,2)
IF 'DCIEN
QUIT
+10 IF "PF"[$PIECE($GET(^PXRMD(801.41,DCIEN,0)),U,4)
Begin DoDot:2
+11 SET ^TMP("PXRMDLG4",$JOB,"IEN",NSEL)=DIEN_U_DSEQ
+12 SET ^TMP("PXRMDLG4",$JOB,"SEQ",LEV_DSEQ)=DCIEN
End DoDot:2
QUIT
+13 ;Save line in workfile
+14 DO DLINE(DCIEN,LEV,DSEQ,NODE)
+15 ;Build pointers back to parent
+16 IF VIEW'=4
Begin DoDot:2
+17 SET ^TMP("PXRMDLG4",$JOB,"IEN",NSEL)=DIEN_U_DSEQ
+18 SET ^TMP("PXRMDLG4",$JOB,"SEQ",LEV_DSEQ)=DCIEN
End DoDot:2
+19 ;Process any sub-components
+20 IF VIEW<5
DO DETAIL(DCIEN,LEV_DSEQ_".",VIEW,NODE)
End DoDot:1
+21 QUIT
+22 ;
DLINE(DIEN,LEV,DSEQ,NODE) ;Save individual component details
+1 NEW CNT,DBOX,DCAP,DDIS,DMULT,DSUPP,DSHOW,DTYP,DTXT
+2 NEW IC,RESNM,RESULT,RIEN,RNAME,RCNT
+3 ;Dialog name
+4 SET DDATA=$GET(^PXRMD(801.41,DIEN,0))
SET DNAM=$PIECE(DDATA,U)
IF DNAM=""
QUIT
+5 ;Check if standard PXRM prompt
+6 IF $$PXRM^PXRMEXID(DNAM)
QUIT
+7 ;Dialog Type and Disabled
+8 SET DDIS=$PIECE(DDATA,U,3)
SET DTYP=$PIECE(DDATA,U,4)
+9 SET DTYP=$SELECT(DTYP="G":"Group",1:"Element")
SET DNAM=DTYP_": "_DNAM
+10 IF VIEW=5
SET DNAM=DNAM
+11 ;Resolution type and name
+12 SET RNAME=""
SET RIEN=$PIECE($GET(^PXRMD(801.41,DIEN,1)),U,3)
+13 IF RIEN
SET RNAME=$PIECE($GET(^PXRMD(801.9,RIEN,0)),U)
+14 ;
+15 ;Group fields
+16 IF DTYP="Group"
Begin DoDot:1
+17 SET DGRP=1
SET DTXT=$PIECE(DDATA,U,5)
SET DCAP=" [group caption]"
+18 IF DTXT=""
SET DCAP=""
+19 IF DTXT]""
SET DCAP=DTXT_" "_DCAP
+20 SET DBOX=$SELECT($PIECE(DDATA,U,6)="Y":"BOX",1:"NO BOX")
+21 SET DSUPP=$SELECT($PIECE(DDATA,U,11):"SUPPRESS",1:"NO SUPPRESS")
+22 SET DSHOW=$SELECT($PIECE(DDATA,U,10):"HIDE",1:"SHOW")
+23 SET DMULT=$PIECE(DDATA,U,9)
+24 SET DMULT=$SELECT(DMULT=1:"ONE ONLY",DMULT=2:"ONE OR MORE",DMULT=3:"NONE OR ONE",DMULT=4:"ALL REQUIRED",1:"NO SELECTION")
End DoDot:1
+25 ;
+26 NEW DPTX,DTXT,EXIST,ITEM,TEMP,SEP,SEQ,TAB,ALTLEN
+27 SET NSEL=NSEL+1
SET NLINE=NLINE+1
SET ITEM=NSEL
SET SEP=$EXTRACT(LEV,$LENGTH(LEV))
SET SEQ=LEV_DSEQ
+28 ;Suppress Item numbers for INQ options
+29 IF VIEW=4
SET ITEM=""
+30 ;Otherwise display Item, Sequence and Dialog Name
+31 SET TEMP=$JUSTIFY(ITEM,4)_$JUSTIFY("",3)_SEQ
SET TAB=$LENGTH(TEMP)+2
+32 SET CNT=0
FOR IC=1:1
IF '$PIECE(SEQ,".",IC)
QUIT
IF $PIECE(SEQ,".",IC)<10
SET CNT=CNT+1
+33 SET TAB=TAB+CNT
+34 ;
+35 SET ALTLEN=$LENGTH(TEMP)
+36 ;Display dialog name
+37 SET TEMP=TEMP_$JUSTIFY("",2+CNT)_DNAM
+38 ;Add disabled if present
+39 IF +DDIS>0
SET TEMP=TEMP_" (Disabled)"
+40 ;
+41 SET ^TMP(NODE,$JOB,NLINE,0)=TEMP
+42 ;check for alternate dialog element/group
+43 IF VIEW<2!(VIEW>4)
Begin DoDot:1
+44 IF $DATA(^PXRMD(801.41,DIEN,49))>0
DO ALT^PXRMDLG5(DIEN,LEV,DSEQ,NODE,VIEW,.NLINE,CNT,ALTLEN)
End DoDot:1
+45 ;
+46 ;Dialog Text or P/N Text
+47 IF (VIEW=2)!(VIEW=3)!(VIEW=4)
Begin DoDot:1
+48 NEW DGBEG,DGSUB,TSUB
+49 SET DGSUB=0
SET TSUB=$$TSUB^PXRMDLG1(DIEN,VIEW)
+50 IF VIEW=4
SET DGBEG=$JUSTIFY("",TAB)_"Text: "
+51 IF VIEW'=4
SET DGBEG=$JUSTIFY("",5+$LENGTH(SEQ)+CNT+$LENGTH(DTYP))_"Text: "
+52 DO WP(DIEN,TSUB,65,.DGBEG,.NLINE)
+53 IF DTYP="Group"
Begin DoDot:2
+54 SET TEMP=DGBEG_"["_DBOX_", "_DSUPP_", "_DSHOW_", "_DMULT_"]"
+55 SET NLINE=NLINE+1
SET ^TMP(NODE,$JOB,NLINE,0)=TEMP
End DoDot:2
End DoDot:1
+56 ;
+57 ;Set up selection index
+58 SET ^TMP(NODE,$JOB,"IDX",NSEL,DIEN)=""
+59 ;Insert finding items
+60 IF (VIEW=1)!(VIEW=4)
IF ("Element;Group"[DTYP)
Begin DoDot:1
+61 NEW DSUB,FDATA,FILENUM,FLIT,FLONG,FNAME,FOUND,FREP,FTYP,TEMP
+62 ;Findings
+63 SET FNAME=""
SET FOUND=0
+64 DO FDESC($PIECE($GET(^PXRMD(801.41,DIEN,1)),U,5))
+65 IF FNAME'=""
SET FOUND=1
DO FSAVE(1,FNAME,FTYP,TAB)
+66 ;Resolution
+67 IF RNAME]""
Begin DoDot:2
+68 SET TEMP=$JUSTIFY("",TAB)_"Resolution: "_RNAME
+69 SET NLINE=NLINE+1
SET ^TMP(NODE,$JOB,NLINE,0)=TEMP
End DoDot:2
+70 ;Result Group
+71 IF VIEW=4
Begin DoDot:2
+72 SET RCNT=0
FOR
SET RCNT=$ORDER(^PXRMD(801.41,DIEN,51,RCNT))
IF RCNT'>0
QUIT
Begin DoDot:3
+73 SET RESULT=$PIECE($GET(^PXRMD(801.41,DIEN,51,RCNT,0)),U)
+74 SET RESNM=$PIECE($GET(^PXRMD(801.41,RESULT,0)),U)
IF RESNM=""
QUIT
+75 SET TEMP=$JUSTIFY("",TAB)_"Result Group: "_RESNM
+76 SET NLINE=NLINE+1
SET ^TMP(NODE,$JOB,NLINE,0)=TEMP
End DoDot:3
End DoDot:2
+77 ;Additional findings
+78 DO FADD(DIEN,TAB,VIEW,.NLINE)
End DoDot:1
+79 ;Get additional prompts
+80 IF VIEW=2
Begin DoDot:1
+81 SET FIEN=$PIECE($GET(^PXRMD(801.41,DIEN,1)),U,5)
+82 IF $GET(FIEN)["PXD(811.2,"
DO TAXDISP^PXRMDTAX(FIEN,DSEQ,DIEN,.NLINE,NODE,0,0)
+83 DO FADD(DIEN,TAB,VIEW,.NLINE)
End DoDot:1
+84 IF VIEW
IF VIEW<5
IF "Element;Group"[DTYP
DO PROMPT(DIEN,TAB,"Prompts: ",VIEW)
+85 ;
+86 IF VIEW=4
IF $DATA(^PXRMD(801.41,DIEN,49))>0
DO ALT^PXRMDLG5(DIEN,LEV,DSEQ,NODE,VIEW,.NLINE,CNT,ALTLEN)
+87 SET NLINE=NLINE+1
+88 SET ^TMP(NODE,$JOB,NLINE,0)=$JUSTIFY("",79)
+89 QUIT
+90 ;
FDESC(FIEN) ;Finding description
+1 NEW FGLOB,FITEM,FNUM
+2 SET FGLOB=$PIECE(FIEN,";",2)
IF FGLOB=""
QUIT
+3 SET FITEM=$PIECE(FIEN,";")
IF FITEM=""
QUIT
+4 SET FNUM=" ["_FITEM_"]"
+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)_FNUM
End DoDot:1
QUIT
+8 IF FGLOB["WV"
Begin DoDot:1
+9 SET FTYP="WH NOTIFICATION PURPOSE"
SET FGLOB=U_FGLOB_FITEM_",0)"
+10 SET FNAME=$PIECE($GET(@FGLOB),U)_FNUM
End DoDot:1
QUIT
+11 IF FGLOB["ICPT"
Begin DoDot:1
+12 SET FTYP="PROCEDURE"
SET FGLOB=U_FGLOB_FITEM_",0)"
+13 SET FNAME=$PIECE($GET(@FGLOB),U,2)_FNUM
End DoDot:1
QUIT
+14 IF FGLOB["ORD(101.41"
Begin DoDot:1
+15 SET FTYP="QUICK ORDER"
SET FGLOB=U_FGLOB_FITEM_",0)"
+16 SET FNAME=$PIECE($GET(@FGLOB),U,2)_FNUM
End DoDot:1
QUIT
+17 ;Short name for finding type
+18 SET FTYP=$GET(DEF1(FGLOB))
IF FTYP=""
QUIT
+19 ;Long name
+20 SET FTYP=$GET(DEF2(FTYP))
+21 SET FGLOB=U_FGLOB_FITEM_",0)"
+22 SET FNAME=$PIECE($GET(@FGLOB),U,1)_FNUM
+23 IF FNAME=""
SET FNAME=$PIECE($GET(@FGLOB),U)_FNUM
+24 IF FNAME=""
SET FNAME=FITEM
+25 QUIT
+26 ;
FSAVE(DSUB,FNAME,FTYP,FTAB,FIEN) ;Save finding details
+1 NEW IND,FMTSTR,NL,OUTPUT,TEMP,TEXT
+2 IF DSUB>1
Begin DoDot:1
+3 SET FMTSTR=FTAB_"R^13L1^"_(65-FTAB)_"L"
+4 SET TEXT=U_"Add. Finding:"
End DoDot:1
+5 IF DSUB=1
Begin DoDot:1
+6 SET FMTSTR=FTAB_"R^8L1^"_(70-FTAB)_"L"
+7 SET TEXT=U_"Finding:"
End DoDot:1
+8 SET TEXT=TEXT_U_FNAME_" ("_FTYP_")"
+9 DO COLFMT^PXRMTEXT(FMTSTR,TEXT," ",.NL,.OUTPUT)
+10 FOR IND=1:1:NL
Begin DoDot:1
+11 SET NLINE=NLINE+1
+12 SET ^TMP(NODE,$JOB,NLINE,0)=OUTPUT(IND)
End DoDot:1
+13 QUIT
+14 ;
PROMPT(IEN,TAB,TEXT,VIEW) ;additional prompts in the dialog file
+1 NEW DATA,DDIS,DGSEQ,DSUB,DTITLE,DTXT,DTYP,SEQ,SUB
+2 SET SEQ=0
+3 FOR
SET SEQ=$ORDER(^PXRMD(801.41,IEN,10,"B",SEQ))
IF 'SEQ
QUIT
Begin DoDot:1
+4 SET SUB=$ORDER(^PXRMD(801.41,IEN,10,"B",SEQ,""))
IF 'SUB
QUIT
+5 SET DSUB=$PIECE($GET(^PXRMD(801.41,IEN,10,SUB,0)),U,2)
IF 'DSUB
QUIT
+6 SET DATA=$GET(^PXRMD(801.41,DSUB,0))
IF DATA=""
QUIT
+7 SET DNAME=$PIECE(DATA,U)
SET DDIS=$PIECE(DATA,U,3)
SET DTYP=$PIECE(DATA,U,4)
+8 IF "PF"'[DTYP
QUIT
+9 IF DTYP="F"
SET DNAME=DNAME_" (forced value)"
+10 IF DTYP="P"
IF (VIEW=2)!(VIEW=3)
Begin DoDot:2
+11 ;Override prompt caption
+12 SET DTITLE=$PIECE($GET(^PXRMD(801.41,IEN,10,SUB,0)),U,6)
+13 IF DTITLE=""
SET DTITLE=$PIECE($GET(^PXRMD(801.41,DSUB,2)),U,4)
+14 SET DNAME=DTITLE
End DoDot:2
+15 SET DNAME=$JUSTIFY("",TAB)_TEXT_DNAME
+16 IF +DDIS>0
SET DNAME=DNAME_" (Disabled)"
+17 SET NLINE=NLINE+1
+18 SET ^TMP(NODE,$JOB,NLINE,0)=DNAME
+19 SET TEXT=$JUSTIFY("",$LENGTH(TEXT))
End DoDot:1
+20 QUIT
+21 ;
SEQ(SEQ,PIEN) ;Select sequence number to add
+1 NEW X,Y,TEXT,DIR
+2 KILL DIROUT,DIRUT,DTOUT,DUOUT
+3 SET SEQ=0
+4 SET DIR(0)="FA0;1;30"
+5 SET DIR("A")="Enter a new SEQUENCE NUMBER: "
+6 SET DIR("?")="Enter new sequence number. For detailed help type ??"
+7 SET DIR("??")=U_"D HELP^PXRMDLG4(1)"
+8 DO ^DIR
KILL DIR
+9 IF $DATA(DIROUT)
SET DTOUT=1
+10 IF $DATA(DTOUT)!($DATA(DUOUT))
QUIT
+11 ;
+12 ;Check that sequence number is new
+13 IF $DATA(^TMP("PXRMDLG4",$JOB,"SEQ",X))
Begin DoDot:1
+14 WRITE !,"Sequence number "_X_" already in use."
End DoDot:1
QUIT
+15 ;
+16 ;Check that the parent is a group or reminder dialog
+17 IF X["."
Begin DoDot:1
+18 NEW CLASS,SUB
+19 ;Sequence number of parent
+20 SET SUB=$PIECE(X,".",1,$LENGTH(X,".")-1)
+21 IF $GET(SUB)=""!($GET(SUB)=0)
WRITE !,"Invalid sequence number. A sequence number cannot be less then 1"
HANG 2
QUIT
+22 ;Get IEN of parent dialog or group
+23 SET PIEN=$GET(^TMP("PXRMDLG4",$JOB,"SEQ",SUB))
+24 ;Validate sequence number
+25 IF 'PIEN
WRITE !,"Sequence number is not part of an existing group."
SET X=""
QUIT
+26 ;Validate that the parent is a group or reminder dialog
+27 IF "RG"'[$PIECE($GET(^PXRMD(801.41,PIEN,0)),U,4)
Begin DoDot:2
+28 WRITE !,"New sequences can only be added to groups or reminder dialogs"
End DoDot:2
SET X=""
QUIT
+29 ;Disallow adding elements to national dialogs or groups
+30 IF $PIECE($GET(^PXMRD(801.41,PIEN,100)),U)="N"
Begin DoDot:2
+31 IF (DUZ(0)="@")&($GET(PXRMINST)=1)
QUIT
+32 WRITE !,"Elements cannot be added to a national group"
SET X=""
End DoDot:2
IF X=""
QUIT
End DoDot:1
IF X=""
QUIT
+33 ;
+34 ;If adding to top level parent ien is reminder dialog
+35 IF X?.N
SET PIEN=PXRMDIEN
+36 ;
+37 SET SEQ=$PIECE(X,".",$LENGTH(X,"."))
+38 QUIT
+39 ;
+40 ;
HELP(CALL) ;General help text routine.
+1 NEW HTEXT
+2 NEW DIWF,DIWL,DIWR,IC
+3 SET DIWF="C75"
SET DIWL=0
SET DIWR=75
+4 ;
+5 IF CALL=1
Begin DoDot:1
+6 SET HTEXT(1)="Sequence numbers can be added at any level. Specify the full"
+7 SET HTEXT(2)="number for the level required (e.g. 15.10.20)."
End DoDot:1
+8 ;
+9 DO HELP^PXRMEUT(.HTEXT)
+10 QUIT
+11 ;
