PXRMCSUBOBJ ;SLC/PKR - Routines for CSUB Objects. ;05/19/2020
;;2.0;CLINICAL REMINDERS;**46**;Feb 04, 2005;Build 236
;
;===============
CSUBDATE(FUNCTION,DATEFORMAT,TEXT,FIEVAL) ;CSUB Date Object.
N CELLFORMAT,DATE,EXTDATE,JUSTIFY,LIST,PADC,ROUTINE,WIDTH
S ROUTINE=$P(FUNCTION,"(",1)
S LIST=$P(FUNCTION,"(",2)
S LIST=$P(LIST,")",1)
S CELLFORMAT=$P(DATEFORMAT,":",2,3)
S DATEFORMAT=$P(DATEFORMAT,":",1)
S DATE=$S(ROUTINE="MRD":$$MRD(LIST,.FIEVAL),ROUTINE="MIN_DATE":$$MINDATE(LIST,.FIEVAL),1:0)
S EXTDATE=$S(DATE=0:$G(TEXT),1:$$FMTE^XLFDT(DATE,DATEFORMAT))
I CELLFORMAT'="" D
. S PADC=$P(CELLFORMAT,":",2),CELLFORMAT=$P(CELLFORMAT,":",1)
. S JUSTIFY=$E(CELLFORMAT,1),WIDTH=$P(CELLFORMAT,JUSTIFY,2)_"T"
. S EXTDATE=$S(JUSTIFY="L":$$LJ^XLFSTR(EXTDATE,WIDTH,PADC),JUSTIFY="R":$$RJ^XLFSTR(EXTDATE,WIDTH,PADC),JUSTIFY="C":$$CJ^XLFSTR(EXTDATE,WIDTH,PADC),1:EXTDATE)
Q EXTDATE
;
;===============
CSUBINTE(CSUB,CELLFORMAT,FILENUM,FIELDNUM,FINUM,OCC,SEP,PIECE,TEXT,FIEVAL) ;
;CSUB INTE Object.
N EXTERNAL,INTERNAL,JUSTIFY,MSG,PADC,WIDTH
S CELLFORMAT=$G(CELLFORMAT),OCC=$G(OCC),SEP=$G(SEP)
S PIECE=$G(PIECE,1),TEXT=$G(TEXT)
S INTERNAL=$S(OCC="":$G(FIEVAL(FINUM,CSUB)),1:$G(FIEVAL(FINUM,OCC,CSUB)))
I SEP'="" S INTERNAL=$P(INTERNAL,SEP,PIECE)
S EXTERNAL=$S(INTERNAL'="":$$EXTERNAL^DILFD(FILENUM,FIELDNUM,,INTERNAL,"MSG"),1:TEXT)
I CELLFORMAT'="" D
. S PADC=$P(CELLFORMAT,":",2),CELLFORMAT=$P(CELLFORMAT,":",1)
. S JUSTIFY=$E(CELLFORMAT,1),WIDTH=$P(CELLFORMAT,JUSTIFY,2)_"T"
. S EXTERNAL=$S(JUSTIFY="L":$$LJ^XLFSTR(EXTERNAL,WIDTH,PADC),JUSTIFY="R":$$RJ^XLFSTR(EXTERNAL,WIDTH,PADC),JUSTIFY="C":$$CJ^XLFSTR(EXTERNAL,WIDTH,PADC),1:EXTERNAL)
Q EXTERNAL
;
;===============
CSUBNUM(CSUB,FORMAT,FINUM,OCC,SEP,PIECE,TEXT,FIEVAL) ;CSUB Num Object.
N CELLFORMAT,FMT,FNUM,FTYPE,JUSTIFY,NDEC,NUM,PADC,WIDTH
S OCC=$G(OCC),SEP=$G(SEP),PIECE=$G(PIECE,1),TEXT=$G(TEXT)
S NUM=$S(OCC="":$G(FIEVAL(FINUM,CSUB)),1:$G(FIEVAL(FINUM,OCC,CSUB)))
I SEP'="" S NUM=$P(NUM,SEP,PIECE)
S FTYPE=$P(FORMAT,":",1)
I NUM'="" D
. S FMT=$P(FORMAT,":",2),NDEC=$P(FORMAT,":",3)
. S FNUM=$S(FTYPE="N":$FN(NUM,FMT,NDEC),FTYPE="D":$$FMTE^XLFDT(NUM,FMT),1:NUM)
I NUM="" S FNUM=TEXT
S CELLFORMAT=$S(FTYPE="D":$P(FORMAT,":",3,4),FTYPE="N":$P(FORMAT,":",4,5),1:"")
I CELLFORMAT'="" D
. S PADC=$P(CELLFORMAT,":",2),CELLFORMAT=$P(CELLFORMAT,":",1)
. S JUSTIFY=$E(CELLFORMAT,1),WIDTH=$P(CELLFORMAT,JUSTIFY,2)_"T"
. S FNUM=$S(JUSTIFY="L":$$LJ^XLFSTR(FNUM,WIDTH,PADC),JUSTIFY="R":$$RJ^XLFSTR(FNUM,WIDTH,PADC),JUSTIFY="C":$$CJ^XLFSTR(FNUM,WIDTH,PADC),1:FNUM)
Q FNUM
;
;===============
CSUBOBJ(CSUBLINE,FIEVAL) ;Top-level entry point for CSUB objects, determine
;the object type and branch to it.
N DONE,FINUM,LEN,OBJECT,OBJEND,OBJSEND,OBJSTART,OBJTEXT,OCC,OUTTEXT
S DONE=0,OBJEND=1,OBJSTART=1
S LEN=$L(CSUBLINE)
F Q:DONE D
. S OBJSTART=$F(CSUBLINE,"$$CSUB",OBJEND)-6
. I OBJSTART=-6 S DONE=1 Q
. S OBJEND=$F(CSUBLINE,"(",OBJSTART)-2
. S OBJECT=$E(CSUBLINE,OBJSTART,OBJEND)
. I OBJECT="$$CSUBDATE" D Q
.. N DATEFORMAT,FUNCTION,FUNEND,FUNSTART,RP,TEMP,TEXT
.. S FUNSTART=$F(CSUBLINE,"MRD",OBJEND)-3
.. I FUNSTART=-3 S FUNSTART=$F(CSUBLINE,"MIN_DATE",OBJEND)-8
.. S FUNEND=$F(CSUBLINE,")",OBJEND)-1
.. S FUNCTION=$E(CSUBLINE,FUNSTART,FUNEND)
.. S RP=$F(CSUBLINE,")",FUNEND+2)
.. S TEMP=$E(CSUBLINE,FUNEND+2,RP-2)
.. S DATEFORMAT=$P(TEMP,",",1)
.. S TEXT=$P(TEMP,",",2)
.. S OBJTEXT=$$CSUBDATE(FUNCTION,DATEFORMAT,TEXT,.FIEVAL)
.. S OUTTEXT=$E(CSUBLINE,1,OBJSTART-1)_OBJTEXT_$E(CSUBLINE,RP,LEN)
.. S CSUBLINE=OUTTEXT
. I OBJECT="$$CSUBINTE" D Q
.. N CELLFORMAT,CSUB,FIELDNUM,FILENUM,FNUM,PIECE,RP,SEP,TEMP,TEXT
.. S RP=$F(CSUBLINE,")",OBJEND+2)
.. S TEMP=$E(CSUBLINE,OBJEND+2,RP-2)
.. S CSUB=$P(TEMP,",",1),CELLFORMAT=$P(TEMP,",",2),FILENUM=$P(TEMP,",",3)
.. S FIELDNUM=$P(TEMP,",",4),FINUM=$P(TEMP,",",5),OCC=$P(TEMP,",",6)
.. S SEP=$P(TEMP,",",7),PIECE=$P(TEMP,",",8),TEXT=$P(TEMP,",",9)
.. S OBJTEXT=$$CSUBINTE(CSUB,CELLFORMAT,FILENUM,FIELDNUM,FINUM,OCC,SEP,PIECE,TEXT,.FIEVAL)
.. S OUTTEXT=$E(CSUBLINE,1,OBJSTART-1)_OBJTEXT_$E(CSUBLINE,RP,LEN)
.. S CSUBLINE=OUTTEXT
. I OBJECT="$$CSUBNUM" D Q
.. N CSUB,FORMAT,PIECE,RP,SEP,TEMP,TEXT
.. S RP=$F(CSUBLINE,")",OBJEND+2)
.. S TEMP=$E(CSUBLINE,OBJEND+2,RP-2)
.. S CSUB=$P(TEMP,",",1)
.. I TEMP["N:," D
... S FORMAT=$P(TEMP,",",2,3)
... S FINUM=$P(TEMP,",",4),OCC=$P(TEMP,",",5),SEP=$P(TEMP,",",6)
... S PIECE=$P(TEMP,",",7),TEXT=$P(TEMP,",",8)
.. E D
... S FORMAT=$P(TEMP,",",2)
... S FINUM=$P(TEMP,",",3),OCC=$P(TEMP,",",4),SEP=$P(TEMP,",",5)
... S PIECE=$P(TEMP,",",6),TEXT=$P(TEMP,",",7)
.. S OBJTEXT=$$CSUBNUM(CSUB,FORMAT,FINUM,OCC,SEP,PIECE,TEXT,.FIEVAL)
.. S OUTTEXT=$E(CSUBLINE,1,OBJSTART-1)_OBJTEXT_$E(CSUBLINE,RP,LEN)
.. S CSUBLINE=OUTTEXT
. I OBJECT="$$CSUBTEXT" D Q
.. N CELLFORMAT,CSUB,PIECE,RP,SEP,TEMP,TEXT
.. S RP=$F(CSUBLINE,")",OBJEND+2)
.. S TEMP=$E(CSUBLINE,OBJEND+2,RP-2)
.. S CSUB=$P(TEMP,",",1),CELLFORMAT=$P(TEMP,",",2),FINUM=$P(TEMP,",",3)
.. S OCC=$P(TEMP,",",4),SEP=$P(TEMP,",",5)
.. S PIECE=$P(TEMP,",",6),TEXT=$P(TEMP,",",7)
.. S OBJTEXT=$$CSUBTEXT(CSUB,CELLFORMAT,FINUM,OCC,SEP,PIECE,TEXT,.FIEVAL)
.. S OUTTEXT=$E(CSUBLINE,1,OBJSTART-1)_OBJTEXT_$E(CSUBLINE,RP,LEN)
.. S CSUBLINE=OUTTEXT
Q OUTTEXT
;
;===============
CSUBTEXT(CSUB,CELLFORMAT,FINUM,OCC,SEP,PIECE,TEXT,FIEVAL) ;CSUB Text Object.
N FITEXT,JUSTIFY,PADC,WIDTH
S CELLFORMAT=$G(CELLFORMAT),OCC=$G(OCC)
S SEP=$G(SEP),PIECE=$G(PIECE,1),TEXT=$G(TEXT)
S FITEXT=$S(OCC="":$G(FIEVAL(FINUM,CSUB)),1:$G(FIEVAL(FINUM,OCC,CSUB)))
I SEP'="" S FITEXT=$P(FITEXT,SEP,PIECE)
I FITEXT="" S FITEXT=TEXT
I CELLFORMAT'="" D
. S PADC=$P(CELLFORMAT,":",2),CELLFORMAT=$P(CELLFORMAT,":",1)
. S JUSTIFY=$E(CELLFORMAT,1),WIDTH=$P(CELLFORMAT,JUSTIFY,2)_"T"
. S FITEXT=$S(JUSTIFY="L":$$LJ^XLFSTR(FITEXT,WIDTH,PADC),JUSTIFY="R":$$RJ^XLFSTR(FITEXT,WIDTH,PADC),JUSTIFY="C":$$CJ^XLFSTR(FITEXT,WIDTH,PADC),1:FITEXT)
Q FITEXT
;
;===============
MINDATE(LIST,FIEVAL) ;Oldest date.
N FINUM,IND,MIND,NUMFI,TESTD
S MIND=9991231
S NUMFI=$L(LIST,",")
F IND=1:1:NUMFI D
. S FINUM=$P(LIST,",",IND)
. S TESTD=$G(FIEVAL(FINUM,"DATE"))
. I (TESTD>0),(TESTD<MIND) S MIND=TESTD
I MIND=9991231 S MIND=0
Q MIND
;
;===============
MRD(LIST,FIEVAL) ;Most recent date.
N FINUM,IND,MRD,NUMFI
S MRD=0
S NUMFI=$L(LIST,",")
F IND=1:1:NUMFI D
. S FINUM=$P(LIST,",",IND)
. I $G(FIEVAL(FINUM,"DATE"))>MRD S MRD=FIEVAL(FINUM,"DATE")
Q MRD
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRMCSUBOBJ 6550 printed Oct 16, 2024@17:44:14 Page 2
PXRMCSUBOBJ ;SLC/PKR - Routines for CSUB Objects. ;05/19/2020
+1 ;;2.0;CLINICAL REMINDERS;**46**;Feb 04, 2005;Build 236
+2 ;
+3 ;===============
CSUBDATE(FUNCTION,DATEFORMAT,TEXT,FIEVAL) ;CSUB Date Object.
+1 NEW CELLFORMAT,DATE,EXTDATE,JUSTIFY,LIST,PADC,ROUTINE,WIDTH
+2 SET ROUTINE=$PIECE(FUNCTION,"(",1)
+3 SET LIST=$PIECE(FUNCTION,"(",2)
+4 SET LIST=$PIECE(LIST,")",1)
+5 SET CELLFORMAT=$PIECE(DATEFORMAT,":",2,3)
+6 SET DATEFORMAT=$PIECE(DATEFORMAT,":",1)
+7 SET DATE=$SELECT(ROUTINE="MRD":$$MRD(LIST,.FIEVAL),ROUTINE="MIN_DATE":$$MINDATE(LIST,.FIEVAL),1:0)
+8 SET EXTDATE=$SELECT(DATE=0:$GET(TEXT),1:$$FMTE^XLFDT(DATE,DATEFORMAT))
+9 IF CELLFORMAT'=""
Begin DoDot:1
+10 SET PADC=$PIECE(CELLFORMAT,":",2)
SET CELLFORMAT=$PIECE(CELLFORMAT,":",1)
+11 SET JUSTIFY=$EXTRACT(CELLFORMAT,1)
SET WIDTH=$PIECE(CELLFORMAT,JUSTIFY,2)_"T"
+12 SET EXTDATE=$SELECT(JUSTIFY="L":$$LJ^XLFSTR(EXTDATE,WIDTH,PADC),JUSTIFY="R":$$RJ^XLFSTR(EXTDATE,WIDTH,PADC),JUSTIFY="C":$$CJ^XLFSTR(EXTDATE,WIDTH,PADC),1:EXTDATE)
End DoDot:1
+13 QUIT EXTDATE
+14 ;
+15 ;===============
CSUBINTE(CSUB,CELLFORMAT,FILENUM,FIELDNUM,FINUM,OCC,SEP,PIECE,TEXT,FIEVAL) ;
+1 ;CSUB INTE Object.
+2 NEW EXTERNAL,INTERNAL,JUSTIFY,MSG,PADC,WIDTH
+3 SET CELLFORMAT=$GET(CELLFORMAT)
SET OCC=$GET(OCC)
SET SEP=$GET(SEP)
+4 SET PIECE=$GET(PIECE,1)
SET TEXT=$GET(TEXT)
+5 SET INTERNAL=$SELECT(OCC="":$GET(FIEVAL(FINUM,CSUB)),1:$GET(FIEVAL(FINUM,OCC,CSUB)))
+6 IF SEP'=""
SET INTERNAL=$PIECE(INTERNAL,SEP,PIECE)
+7 SET EXTERNAL=$SELECT(INTERNAL'="":$$EXTERNAL^DILFD(FILENUM,FIELDNUM,,INTERNAL,"MSG"),1:TEXT)
+8 IF CELLFORMAT'=""
Begin DoDot:1
+9 SET PADC=$PIECE(CELLFORMAT,":",2)
SET CELLFORMAT=$PIECE(CELLFORMAT,":",1)
+10 SET JUSTIFY=$EXTRACT(CELLFORMAT,1)
SET WIDTH=$PIECE(CELLFORMAT,JUSTIFY,2)_"T"
+11 SET EXTERNAL=$SELECT(JUSTIFY="L":$$LJ^XLFSTR(EXTERNAL,WIDTH,PADC),JUSTIFY="R":$$RJ^XLFSTR(EXTERNAL,WIDTH,PADC),JUSTIFY="C":$$CJ^XLFSTR(EXTERNAL,WIDTH,PADC),1:EXTERNAL)
End DoDot:1
+12 QUIT EXTERNAL
+13 ;
+14 ;===============
CSUBNUM(CSUB,FORMAT,FINUM,OCC,SEP,PIECE,TEXT,FIEVAL) ;CSUB Num Object.
+1 NEW CELLFORMAT,FMT,FNUM,FTYPE,JUSTIFY,NDEC,NUM,PADC,WIDTH
+2 SET OCC=$GET(OCC)
SET SEP=$GET(SEP)
SET PIECE=$GET(PIECE,1)
SET TEXT=$GET(TEXT)
+3 SET NUM=$SELECT(OCC="":$GET(FIEVAL(FINUM,CSUB)),1:$GET(FIEVAL(FINUM,OCC,CSUB)))
+4 IF SEP'=""
SET NUM=$PIECE(NUM,SEP,PIECE)
+5 SET FTYPE=$PIECE(FORMAT,":",1)
+6 IF NUM'=""
Begin DoDot:1
+7 SET FMT=$PIECE(FORMAT,":",2)
SET NDEC=$PIECE(FORMAT,":",3)
+8 SET FNUM=$SELECT(FTYPE="N":$FNUMBER(NUM,FMT,NDEC),FTYPE="D":$$FMTE^XLFDT(NUM,FMT),1:NUM)
End DoDot:1
+9 IF NUM=""
SET FNUM=TEXT
+10 SET CELLFORMAT=$SELECT(FTYPE="D":$PIECE(FORMAT,":",3,4),FTYPE="N":$PIECE(FORMAT,":",4,5),1:"")
+11 IF CELLFORMAT'=""
Begin DoDot:1
+12 SET PADC=$PIECE(CELLFORMAT,":",2)
SET CELLFORMAT=$PIECE(CELLFORMAT,":",1)
+13 SET JUSTIFY=$EXTRACT(CELLFORMAT,1)
SET WIDTH=$PIECE(CELLFORMAT,JUSTIFY,2)_"T"
+14 SET FNUM=$SELECT(JUSTIFY="L":$$LJ^XLFSTR(FNUM,WIDTH,PADC),JUSTIFY="R":$$RJ^XLFSTR(FNUM,WIDTH,PADC),JUSTIFY="C":$$CJ^XLFSTR(FNUM,WIDTH,PADC),1:FNUM)
End DoDot:1
+15 QUIT FNUM
+16 ;
+17 ;===============
CSUBOBJ(CSUBLINE,FIEVAL) ;Top-level entry point for CSUB objects, determine
+1 ;the object type and branch to it.
+2 NEW DONE,FINUM,LEN,OBJECT,OBJEND,OBJSEND,OBJSTART,OBJTEXT,OCC,OUTTEXT
+3 SET DONE=0
SET OBJEND=1
SET OBJSTART=1
+4 SET LEN=$LENGTH(CSUBLINE)
+5 FOR
if DONE
QUIT
Begin DoDot:1
+6 SET OBJSTART=$FIND(CSUBLINE,"$$CSUB",OBJEND)-6
+7 IF OBJSTART=-6
SET DONE=1
QUIT
+8 SET OBJEND=$FIND(CSUBLINE,"(",OBJSTART)-2
+9 SET OBJECT=$EXTRACT(CSUBLINE,OBJSTART,OBJEND)
+10 IF OBJECT="$$CSUBDATE"
Begin DoDot:2
+11 NEW DATEFORMAT,FUNCTION,FUNEND,FUNSTART,RP,TEMP,TEXT
+12 SET FUNSTART=$FIND(CSUBLINE,"MRD",OBJEND)-3
+13 IF FUNSTART=-3
SET FUNSTART=$FIND(CSUBLINE,"MIN_DATE",OBJEND)-8
+14 SET FUNEND=$FIND(CSUBLINE,")",OBJEND)-1
+15 SET FUNCTION=$EXTRACT(CSUBLINE,FUNSTART,FUNEND)
+16 SET RP=$FIND(CSUBLINE,")",FUNEND+2)
+17 SET TEMP=$EXTRACT(CSUBLINE,FUNEND+2,RP-2)
+18 SET DATEFORMAT=$PIECE(TEMP,",",1)
+19 SET TEXT=$PIECE(TEMP,",",2)
+20 SET OBJTEXT=$$CSUBDATE(FUNCTION,DATEFORMAT,TEXT,.FIEVAL)
+21 SET OUTTEXT=$EXTRACT(CSUBLINE,1,OBJSTART-1)_OBJTEXT_$EXTRACT(CSUBLINE,RP,LEN)
+22 SET CSUBLINE=OUTTEXT
End DoDot:2
QUIT
+23 IF OBJECT="$$CSUBINTE"
Begin DoDot:2
+24 NEW CELLFORMAT,CSUB,FIELDNUM,FILENUM,FNUM,PIECE,RP,SEP,TEMP,TEXT
+25 SET RP=$FIND(CSUBLINE,")",OBJEND+2)
+26 SET TEMP=$EXTRACT(CSUBLINE,OBJEND+2,RP-2)
+27 SET CSUB=$PIECE(TEMP,",",1)
SET CELLFORMAT=$PIECE(TEMP,",",2)
SET FILENUM=$PIECE(TEMP,",",3)
+28 SET FIELDNUM=$PIECE(TEMP,",",4)
SET FINUM=$PIECE(TEMP,",",5)
SET OCC=$PIECE(TEMP,",",6)
+29 SET SEP=$PIECE(TEMP,",",7)
SET PIECE=$PIECE(TEMP,",",8)
SET TEXT=$PIECE(TEMP,",",9)
+30 SET OBJTEXT=$$CSUBINTE(CSUB,CELLFORMAT,FILENUM,FIELDNUM,FINUM,OCC,SEP,PIECE,TEXT,.FIEVAL)
+31 SET OUTTEXT=$EXTRACT(CSUBLINE,1,OBJSTART-1)_OBJTEXT_$EXTRACT(CSUBLINE,RP,LEN)
+32 SET CSUBLINE=OUTTEXT
End DoDot:2
QUIT
+33 IF OBJECT="$$CSUBNUM"
Begin DoDot:2
+34 NEW CSUB,FORMAT,PIECE,RP,SEP,TEMP,TEXT
+35 SET RP=$FIND(CSUBLINE,")",OBJEND+2)
+36 SET TEMP=$EXTRACT(CSUBLINE,OBJEND+2,RP-2)
+37 SET CSUB=$PIECE(TEMP,",",1)
+38 IF TEMP["N:,"
Begin DoDot:3
+39 SET FORMAT=$PIECE(TEMP,",",2,3)
+40 SET FINUM=$PIECE(TEMP,",",4)
SET OCC=$PIECE(TEMP,",",5)
SET SEP=$PIECE(TEMP,",",6)
+41 SET PIECE=$PIECE(TEMP,",",7)
SET TEXT=$PIECE(TEMP,",",8)
End DoDot:3
+42 IF '$TEST
Begin DoDot:3
+43 SET FORMAT=$PIECE(TEMP,",",2)
+44 SET FINUM=$PIECE(TEMP,",",3)
SET OCC=$PIECE(TEMP,",",4)
SET SEP=$PIECE(TEMP,",",5)
+45 SET PIECE=$PIECE(TEMP,",",6)
SET TEXT=$PIECE(TEMP,",",7)
End DoDot:3
+46 SET OBJTEXT=$$CSUBNUM(CSUB,FORMAT,FINUM,OCC,SEP,PIECE,TEXT,.FIEVAL)
+47 SET OUTTEXT=$EXTRACT(CSUBLINE,1,OBJSTART-1)_OBJTEXT_$EXTRACT(CSUBLINE,RP,LEN)
+48 SET CSUBLINE=OUTTEXT
End DoDot:2
QUIT
+49 IF OBJECT="$$CSUBTEXT"
Begin DoDot:2
+50 NEW CELLFORMAT,CSUB,PIECE,RP,SEP,TEMP,TEXT
+51 SET RP=$FIND(CSUBLINE,")",OBJEND+2)
+52 SET TEMP=$EXTRACT(CSUBLINE,OBJEND+2,RP-2)
+53 SET CSUB=$PIECE(TEMP,",",1)
SET CELLFORMAT=$PIECE(TEMP,",",2)
SET FINUM=$PIECE(TEMP,",",3)
+54 SET OCC=$PIECE(TEMP,",",4)
SET SEP=$PIECE(TEMP,",",5)
+55 SET PIECE=$PIECE(TEMP,",",6)
SET TEXT=$PIECE(TEMP,",",7)
+56 SET OBJTEXT=$$CSUBTEXT(CSUB,CELLFORMAT,FINUM,OCC,SEP,PIECE,TEXT,.FIEVAL)
+57 SET OUTTEXT=$EXTRACT(CSUBLINE,1,OBJSTART-1)_OBJTEXT_$EXTRACT(CSUBLINE,RP,LEN)
+58 SET CSUBLINE=OUTTEXT
End DoDot:2
QUIT
End DoDot:1
+59 QUIT OUTTEXT
+60 ;
+61 ;===============
CSUBTEXT(CSUB,CELLFORMAT,FINUM,OCC,SEP,PIECE,TEXT,FIEVAL) ;CSUB Text Object.
+1 NEW FITEXT,JUSTIFY,PADC,WIDTH
+2 SET CELLFORMAT=$GET(CELLFORMAT)
SET OCC=$GET(OCC)
+3 SET SEP=$GET(SEP)
SET PIECE=$GET(PIECE,1)
SET TEXT=$GET(TEXT)
+4 SET FITEXT=$SELECT(OCC="":$GET(FIEVAL(FINUM,CSUB)),1:$GET(FIEVAL(FINUM,OCC,CSUB)))
+5 IF SEP'=""
SET FITEXT=$PIECE(FITEXT,SEP,PIECE)
+6 IF FITEXT=""
SET FITEXT=TEXT
+7 IF CELLFORMAT'=""
Begin DoDot:1
+8 SET PADC=$PIECE(CELLFORMAT,":",2)
SET CELLFORMAT=$PIECE(CELLFORMAT,":",1)
+9 SET JUSTIFY=$EXTRACT(CELLFORMAT,1)
SET WIDTH=$PIECE(CELLFORMAT,JUSTIFY,2)_"T"
+10 SET FITEXT=$SELECT(JUSTIFY="L":$$LJ^XLFSTR(FITEXT,WIDTH,PADC),JUSTIFY="R":$$RJ^XLFSTR(FITEXT,WIDTH,PADC),JUSTIFY="C":$$CJ^XLFSTR(FITEXT,WIDTH,PADC),1:FITEXT)
End DoDot:1
+11 QUIT FITEXT
+12 ;
+13 ;===============
MINDATE(LIST,FIEVAL) ;Oldest date.
+1 NEW FINUM,IND,MIND,NUMFI,TESTD
+2 SET MIND=9991231
+3 SET NUMFI=$LENGTH(LIST,",")
+4 FOR IND=1:1:NUMFI
Begin DoDot:1
+5 SET FINUM=$PIECE(LIST,",",IND)
+6 SET TESTD=$GET(FIEVAL(FINUM,"DATE"))
+7 IF (TESTD>0)
IF (TESTD<MIND)
SET MIND=TESTD
End DoDot:1
+8 IF MIND=9991231
SET MIND=0
+9 QUIT MIND
+10 ;
+11 ;===============
MRD(LIST,FIEVAL) ;Most recent date.
+1 NEW FINUM,IND,MRD,NUMFI
+2 SET MRD=0
+3 SET NUMFI=$LENGTH(LIST,",")
+4 FOR IND=1:1:NUMFI
Begin DoDot:1
+5 SET FINUM=$PIECE(LIST,",",IND)
+6 IF $GET(FIEVAL(FINUM,"DATE"))>MRD
SET MRD=FIEVAL(FINUM,"DATE")
End DoDot:1
+7 QUIT MRD
+8 ;
