- 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 Feb 18, 2025@23:10:15 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 ;