PXRMDLG1 ; SLC/PJH - Reminder Dialog Edit/Inquiry (overflow) ;08/20/2012
;;2.0;CLINICAL REMINDERS;**12,26**;Feb 04, 2005;Build 404
;
;Either dialog text or P/N text
;------------------------------
TSUB(IEN,VIEW) ;
;Dialog View uses Dialog text
I VIEW=1 Q 25
I VIEW=2,$D(^PXRMD(801.41,IEN,25)) Q 25
;P/N View uses P/N TEXT if defined
I $D(^PXRMD(801.41,IEN,35)) Q 35
;Otherwise Dialog Text
Q 25
;
;additional prompts in the dialog file
;-------------------------------------
PROMPT(IEN,TAB,TEXT,DGRP) ;
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 VIEW,('DGRP),(DTYP'="P") Q
.I ('VIEW),('DGRP),("FP"'[DTYP) Q
.S:VIEW DDIS=""
.I DTYP="F" S DNAME=DNAME_" (forced value)"
.I DGRP D
..S DGSEQ=$P($G(^PXRMD(801.41,IEN,10,SUB,0)),U)
..S DNAME=DGSEQ_$J("",3-$L(DGSEQ))_DNAME
.I TAB=0,DTYP="P" 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=$J("",3)_DTITLE
.I TAB=0,DTYP="F" S DNAME=$J("",3)_DNAME
.S DNAME=$J("",15)_$G(TEXT)_DNAME
.;S:DDIS]"" DNAME=DNAME_$J("",72-$L(DNAME))_DDIS
.S:+DDIS>0 DNAME=DNAME_$J("",72-$L(DNAME))_" (Disabled)"
.S VALMCNT=VALMCNT+1
.S ^TMP("PXRMDLG",$J,VALMCNT,0)=DNAME
.S TEXT=$J("",TAB)
Q
;
FIND(FIEN,SEQ,DIEN,NLINE,NODE) ;
N FNUM,TIEN,HIST,SUB,CODE,CODES,CODESYS,BDATE,EDATE,DATE,DESC,DTEXT
S HIST=0
S TIEN=$P(FIEN,";")
D BLDCODE^PXRMDTAX("ALL",.CODESYS)
D CODES^PXRMDLLB(TIEN,.CODESYS,.CODES)
S TEXT=$J("",15)_"Selectable codes:",TAB=18
S STR=$$LJ^XLFSTR($G(TEXT),60)
S STR=STR_"Activation Periods"
S NLINE=NLINE+1
S ^TMP(NODE,$J,NLINE,0)=STR
S BDATE=""
F S BDATE=$O(CODES(BDATE)) Q:BDATE="" D
.I $G(BDATE)=0 Q
.S EDATE=$P(CODES(BDATE),U),DESC=$P(CODES(BDATE),U,2)
.S BDATE=$$FMTE^XLFDT(BDATE)
.I $G(EDATE)'="" S EDATE=$$FMTE^XLFDT(EDATE)
.S DATE=BDATE I $G(EDATE)'="" S DATE=DATE_"-"_EDATE
.S STR=$$LJ^XLFSTR($G(CODE),8)
.S STR=STR_$$LJ^XLFSTR(DESC,31)
.S DTEXT=STR_DATE
.S NLINE=NLINE+1
.S ^TMP(NODE,$J,NLINE,0)=$J("",15)_DTEXT
S NLINE=NLINE+1
S ^TMP(NODE,$J,NLINE,0)=$J("",79)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMDLG1 2423 printed Dec 13, 2024@01:43:53 Page 2
PXRMDLG1 ; SLC/PJH - Reminder Dialog Edit/Inquiry (overflow) ;08/20/2012
+1 ;;2.0;CLINICAL REMINDERS;**12,26**;Feb 04, 2005;Build 404
+2 ;
+3 ;Either dialog text or P/N text
+4 ;------------------------------
TSUB(IEN,VIEW) ;
+1 ;Dialog View uses Dialog text
+2 IF VIEW=1
QUIT 25
+3 IF VIEW=2
IF $DATA(^PXRMD(801.41,IEN,25))
QUIT 25
+4 ;P/N View uses P/N TEXT if defined
+5 IF $DATA(^PXRMD(801.41,IEN,35))
QUIT 35
+6 ;Otherwise Dialog Text
+7 QUIT 25
+8 ;
+9 ;additional prompts in the dialog file
+10 ;-------------------------------------
PROMPT(IEN,TAB,TEXT,DGRP) ;
+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 VIEW
IF ('DGRP)
IF (DTYP'="P")
QUIT
+9 IF ('VIEW)
IF ('DGRP)
IF ("FP"'[DTYP)
QUIT
+10 if VIEW
SET DDIS=""
+11 IF DTYP="F"
SET DNAME=DNAME_" (forced value)"
+12 IF DGRP
Begin DoDot:2
+13 SET DGSEQ=$PIECE($GET(^PXRMD(801.41,IEN,10,SUB,0)),U)
+14 SET DNAME=DGSEQ_$JUSTIFY("",3-$LENGTH(DGSEQ))_DNAME
End DoDot:2
+15 IF TAB=0
IF DTYP="P"
Begin DoDot:2
+16 ;Override prompt caption
+17 SET DTITLE=$PIECE($GET(^PXRMD(801.41,IEN,10,SUB,0)),U,6)
+18 IF DTITLE=""
SET DTITLE=$PIECE($GET(^PXRMD(801.41,DSUB,2)),U,4)
+19 SET DNAME=$JUSTIFY("",3)_DTITLE
End DoDot:2
+20 IF TAB=0
IF DTYP="F"
SET DNAME=$JUSTIFY("",3)_DNAME
+21 SET DNAME=$JUSTIFY("",15)_$GET(TEXT)_DNAME
+22 ;S:DDIS]"" DNAME=DNAME_$J("",72-$L(DNAME))_DDIS
+23 if +DDIS>0
SET DNAME=DNAME_$JUSTIFY("",72-$LENGTH(DNAME))_" (Disabled)"
+24 SET VALMCNT=VALMCNT+1
+25 SET ^TMP("PXRMDLG",$JOB,VALMCNT,0)=DNAME
+26 SET TEXT=$JUSTIFY("",TAB)
End DoDot:1
+27 QUIT
+28 ;
FIND(FIEN,SEQ,DIEN,NLINE,NODE) ;
+1 NEW FNUM,TIEN,HIST,SUB,CODE,CODES,CODESYS,BDATE,EDATE,DATE,DESC,DTEXT
+2 SET HIST=0
+3 SET TIEN=$PIECE(FIEN,";")
+4 DO BLDCODE^PXRMDTAX("ALL",.CODESYS)
+5 DO CODES^PXRMDLLB(TIEN,.CODESYS,.CODES)
+6 SET TEXT=$JUSTIFY("",15)_"Selectable codes:"
SET TAB=18
+7 SET STR=$$LJ^XLFSTR($GET(TEXT),60)
+8 SET STR=STR_"Activation Periods"
+9 SET NLINE=NLINE+1
+10 SET ^TMP(NODE,$JOB,NLINE,0)=STR
+11 SET BDATE=""
+12 FOR
SET BDATE=$ORDER(CODES(BDATE))
if BDATE=""
QUIT
Begin DoDot:1
+13 IF $GET(BDATE)=0
QUIT
+14 SET EDATE=$PIECE(CODES(BDATE),U)
SET DESC=$PIECE(CODES(BDATE),U,2)
+15 SET BDATE=$$FMTE^XLFDT(BDATE)
+16 IF $GET(EDATE)'=""
SET EDATE=$$FMTE^XLFDT(EDATE)
+17 SET DATE=BDATE
IF $GET(EDATE)'=""
SET DATE=DATE_"-"_EDATE
+18 SET STR=$$LJ^XLFSTR($GET(CODE),8)
+19 SET STR=STR_$$LJ^XLFSTR(DESC,31)
+20 SET DTEXT=STR_DATE
+21 SET NLINE=NLINE+1
+22 SET ^TMP(NODE,$JOB,NLINE,0)=$JUSTIFY("",15)_DTEXT
End DoDot:1
+23 SET NLINE=NLINE+1
+24 SET ^TMP(NODE,$JOB,NLINE,0)=$JUSTIFY("",79)
+25 QUIT
+26 ;
