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  Sep 23, 2025@19:19:52                                                                                                                                                                                                    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      ;