- 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 Mar 13, 2025@20:48:03 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 ;
