- HMPDJX ;SLC/MKB,ASMR/RRB,BL - New data update;Aug 29, 2016 20:06:27
- ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**3**;Sep 01, 2011;Build 15
- ;Per VA Directive 6402, this routine should not be modified.
- ;
- ; External References DBIA#
- ; ------------------- -----
- ; ^DPT 10035
- ; MPIF001 2701
- ; XLFSTR 10104
- Q
- ;
- EN(LAST,MAX) ; -- get data from ^XTMP("HMP-<date>",n)
- ; Expects HMP=$NA(^TMP("HMP",$J))
- ;
- N SYS,X,Y,HMPTOTL,DFN,PATCNT,ICN,DOMCNT,TYPE,RTN,HMPLASTI,HMPID,DATA,DELETE,UID,CNT,TSTART,TSTOP
- S TSTART=$$NOW^XLFDT()
- S LAST=$G(LAST),SYS=$G(FILTER("systemID")) Q:SYS=""
- S MAX=$G(MAX,999)
- D GETLIST(LAST,SYS,MAX)
- ;
- S (DFN,PATCNT,HMPTOTL)=0 F S DFN=$O(^TMP("HMPX",$J,DFN)) Q:'(DFN>0) D ;DE4496 19 August 2016
- . K ^TMP($J,"HMP ERROR")
- . S PATCNT=PATCNT+1,ICN=+$$GETICN^MPIF001(DFN),ERRPAT=DFN
- . S DOMCNT=0 K DATA,DELETE
- . S TYPE="" F S TYPE=$O(^TMP("HMPX",$J,DFN,TYPE)) Q:TYPE="" D
- .. S RTN=$$TAG^HMPDJ(TYPE)_"^HMPDJ0" Q:'$L($T(@RTN))
- .. S DOMCNT=DOMCNT+1
- .. ;
- .. N HMP S HMP=$NA(^TMP("HMP",$J,PATCNT,DOMCNT)),HMPI=0,HMPID=""
- .. F S HMPID=$O(^TMP("HMPX",$J,DFN,TYPE,HMPID)) Q:HMPID="" S X=$G(^(HMPID)) D
- ... N $ES,$ET,ERRPAT,ERRMSG
- ... S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
- ... S ERRMSG="A problem occurred when trying to refresh patient data from an API."
- ... ;
- ... I X="@" D DELETE(TYPE,DFN,HMPID) Q
- ... S HMPLASTI=HMPI D @RTN ;creates @HMP@(HMPI+1)
- ... ;
- ... ; if no new item, assume the record has been deleted
- ... I HMPI'>HMPLASTI D DELETE(TYPE,DFN,HMPID) Q
- ... S HMPTOTL=HMPTOTL+1,DATA=1
- .. I 'HMPI S DOMCNT=DOMCNT-1 Q ;no data, or error
- .. ;
- .. S:DOMCNT>1 @HMP@(.3)=","
- .. S @HMP@(.5)="{""domainName"":"""_TYPE_""",""total"":"_HMPI_",""items"":["
- .. S HMPI=HMPI+1,@HMP@(HMPI)="]}"
- . ;
- A . ; HMP=$NA(^TMP("HMP",$J)) again
- . S:PATCNT>1 @HMP@(PATCNT,.3)=","
- . S @HMP@(PATCNT,.5)="{""patientDfn"":"_DFN_",""patientIcn"":"""_ICN_""""
- . I DOMCNT D
- .. S @HMP@(PATCNT,.6)=",""domains"":["
- .. S DOMCNT=DOMCNT+1,@HMP@(PATCNT,DOMCNT)="]"
- . ;
- . I $D(DELETE) D
- .. S DOMCNT=DOMCNT+1,@HMP@(PATCNT,DOMCNT,.5)=",""deletes"":["
- .. S HMPI=0,UID="" F S UID=$O(DELETE(UID)) Q:UID="" D
- ... S TYPE=DELETE(UID),HMPI=HMPI+1
- ... S:HMPI>1 @HMP@(PATCNT,DOMCNT,HMPI,.3)=","
- ... S @HMP@(PATCNT,DOMCNT,HMPI,1)="{""uid"":"""_UID_""",""domainName"":"""_TYPE_"""}"
- .. S HMPI=HMPI+1,@HMP@(PATCNT,DOMCNT,HMPI)="]"
- . ;
- . I $D(^TMP($J,"HMP ERROR")) D
- .. N ERROR D BUILDERR^HMPDJ(.ERROR)
- .. S DOMCNT=DOMCNT+1,@HMP@(PATCNT,DOMCNT,.3)=","
- .. M @HMP@(PATCNT,DOMCNT)=ERROR
- .. K ^TMP($J,"HMP ERROR")
- . ;
- . S DOMCNT=DOMCNT+1,@HMP@(PATCNT,DOMCNT)="}"
- ;
- S Y=$G(^TMP("HMPX",$J,0)) S:Y="" Y=LAST
- S T=$$NOW^XLFDT()
- S @HMP@(.5)="{""apiVersion"":""1.01"",""data"":{""lastUpdate"":"""_Y_""",""startDateTime"":"""_TSTART_""",""totalPatients"":"_PATCNT
- S:PATCNT @HMP@(.6)=",""patients"":[",PATCNT=PATCNT+1,@HMP@(PATCNT)="]"
- ;
- B ;
- I $D(^TMP("HMPX",$J,"OP")) D ;operational data
- . S (HMPTOTL,DOMCNT)=0,PATCNT=PATCNT+1 K DATA,DELETE
- . S TYPE="" F S TYPE=$O(^TMP("HMPX",$J,"OP",TYPE)) Q:TYPE="" D
- .. S RTN=$$TAG^HMPEF(TYPE)_"^HMPEF" Q:'$L($T(@RTN))
- .. S DOMCNT=DOMCNT+1,DFN=""
- .. ;
- .. N HMP S HMP=$NA(^TMP("HMP",$J,PATCNT,DOMCNT)),HMPI=0,HMPID=""
- .. F S HMPID=$O(^TMP("HMPX",$J,"OP",TYPE,HMPID)) Q:HMPID="" S X=$G(^(HMPID)) D
- ... I X="@" D DELETE(TYPE,DFN,HMPID) Q
- ... S HMPLASTI=HMPI D @RTN ;creates @HMP@(HMPI+1)
- ... ; if no new item, assume the record has been deleted
- ... I HMPI'>HMPLASTI D DELETE(TYPE,DFN,HMPID) Q
- ... S HMPTOTL=HMPTOTL+1,DATA=1
- .. I 'HMPI S DOMCNT=DOMCNT-1 Q ;no data, or error
- .. ;
- .. S:DOMCNT>1 @HMP@(.3)=","
- .. S @HMP@(.5)="{""domainName"":"""_TYPE_""",""total"":"_HMPI_",""items"":["
- .. S HMPI=HMPI+1,@HMP@(HMPI)="]}"
- . ;
- C . ; HMP=$NA(^TMP("HMP",$J)) again
- . I 'DOMCNT,'$D(DELETE) Q ;no data, or error
- . S @HMP@(PATCNT,.5)=",""operational"":{"
- . I DOMCNT D
- .. S @HMP@(PATCNT,.6)="""domains"":["
- .. S DOMCNT=DOMCNT+1 S @HMP@(PATCNT,DOMCNT)="]"
- . ;
- . I $D(DELETE) D
- .. S DOMCNT=DOMCNT+1 S:DOMCNT>1 @HMP@(PATCNT,DOMCNT,.3)=","
- .. S @HMP@(PATCNT,DOMCNT,.5)="""deletes"":["
- .. S HMPI=0,UID="" F S UID=$O(DELETE(UID)) Q:UID="" D
- ... S TYPE=DELETE(UID),HMPI=HMPI+1
- ... S:HMPI>1 @HMP@(PATCNT,DOMCNT,HMPI,.3)=","
- ... S @HMP@(PATCNT,DOMCNT,HMPI,1)="{""uid"":"""_UID_""",""domainName"":"""_TYPE_"""}"
- .. S HMPI=HMPI+1,@HMP@(PATCNT,DOMCNT,HMPI)="]"
- . ;
- . S DOMCNT=DOMCNT+1,@HMP@(PATCNT,DOMCNT)="}"
- ;
- S TSTOP=$$NOW^XLFDT()
- S PATCNT=PATCNT+1,@HMP@(PATCNT)=",""endDateTime"":"""_TSTOP_"""}}" ;close JSON
- K ^TMP("HMPX",$J),^TMP("HMPTEXT",$J)
- Q
- ;
- DELETE(NAME,DFN,ID) ; -- set DELETE nodes
- N UID
- S UID=$$SETUID^HMPUTILS(NAME,DFN,ID)
- S DELETE(UID)=NAME
- Q
- ;
- GETLIST(LAST,SYS,MAX) ; -- build list of updates for client
- ; Returns ^TMP("HMPX",$J,0) = last DATE:SEQ included
- ; ^TMP("HMPX",$J,DFN,TYPE,ID)=ACT
- N DATE,SEQ,DA,END,IDX,X0,DFN,TYPE,ID,ACT,D,N,CNT
- K ^TMP("HMPX",$J)
- S DATE=+LAST,SEQ=+$P(LAST,":",2),CNT=0
- S DA=$$FIND^HMPPATS(SYS) Q:'DA
- ;
- ; generate list ID, and end point
- S D=DT,N=+$O(^XTMP("HMP-"_DT,"A"),-1) ;last entry, as of now
- I DATE=DT,SEQ=N S ^TMP("HMPX",$J,0)=LAST Q ;no new items
- ;
- S IDX=$NA(^XTMP("HMP-"_DATE,SEQ)),END=N ;init loop where left off
- F S IDX=$Q(@IDX) Q:$$DONE D Q:CNT'<MAX
- . S D=+$P(IDX,"-",2),N=+$P(IDX,",",2)
- . S X0=@IDX,DFN=$P(X0,U) S:DFN="" DFN="OP"
- . I DFN,'$D(^HMP(800000,"ADFN",DFN,DA)) Q
- . S TYPE=$P(X0,U,2),ID=$P(X0,U,3),ACT=$P(X0,U,4)
- . I TYPE=""!(ID="") Q ;error
- . I TYPE="ROSTER",'$D(^HMP(800000,"AROS",ID,DA)) Q
- . S:'$D(^TMP("HMPX",$J,DFN,TYPE,ID)) CNT=CNT+1
- . S ^TMP("HMPX",$J,DFN,TYPE,ID)=ACT
- S ^TMP("HMPX",$J,0)=D_":"_N ;final date:seq
- Q
- ;
- DONE() ; -- Return 1 or 0, if loop has finished
- I IDX'?1"^XTMP(""HMP-"7N.E Q 1 ;end of ^XTMP("HMP")
- N D,N S D=+$P(IDX,"-",2),N=+$P(IDX,",",2)
- ; check HMP-DATE subscript
- I D<DT Q 0 ;prior day: keep going
- I D>DT Q 1 ;next day: stop loop
- ; D=DT: check sequence# subscript
- I N>END Q 1
- Q 0
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPDJX 6260 printed Mar 13, 2025@20:58:16 Page 2
- HMPDJX ;SLC/MKB,ASMR/RRB,BL - New data update;Aug 29, 2016 20:06:27
- +1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**3**;Sep 01, 2011;Build 15
- +2 ;Per VA Directive 6402, this routine should not be modified.
- +3 ;
- +4 ; External References DBIA#
- +5 ; ------------------- -----
- +6 ; ^DPT 10035
- +7 ; MPIF001 2701
- +8 ; XLFSTR 10104
- +9 QUIT
- +10 ;
- EN(LAST,MAX) ; -- get data from ^XTMP("HMP-<date>",n)
- +1 ; Expects HMP=$NA(^TMP("HMP",$J))
- +2 ;
- +3 NEW SYS,X,Y,HMPTOTL,DFN,PATCNT,ICN,DOMCNT,TYPE,RTN,HMPLASTI,HMPID,DATA,DELETE,UID,CNT,TSTART,TSTOP
- +4 SET TSTART=$$NOW^XLFDT()
- +5 SET LAST=$GET(LAST)
- SET SYS=$GET(FILTER("systemID"))
- if SYS=""
- QUIT
- +6 SET MAX=$GET(MAX,999)
- +7 DO GETLIST(LAST,SYS,MAX)
- +8 ;
- +9 ;DE4496 19 August 2016
- SET (DFN,PATCNT,HMPTOTL)=0
- FOR
- SET DFN=$ORDER(^TMP("HMPX",$JOB,DFN))
- if '(DFN>0)
- QUIT
- Begin DoDot:1
- +10 KILL ^TMP($JOB,"HMP ERROR")
- +11 SET PATCNT=PATCNT+1
- SET ICN=+$$GETICN^MPIF001(DFN)
- SET ERRPAT=DFN
- +12 SET DOMCNT=0
- KILL DATA,DELETE
- +13 SET TYPE=""
- FOR
- SET TYPE=$ORDER(^TMP("HMPX",$JOB,DFN,TYPE))
- if TYPE=""
- QUIT
- Begin DoDot:2
- +14 SET RTN=$$TAG^HMPDJ(TYPE)_"^HMPDJ0"
- if '$LENGTH($TEXT(@RTN))
- QUIT
- +15 SET DOMCNT=DOMCNT+1
- +16 ;
- +17 NEW HMP
- SET HMP=$NAME(^TMP("HMP",$JOB,PATCNT,DOMCNT))
- SET HMPI=0
- SET HMPID=""
- +18 FOR
- SET HMPID=$ORDER(^TMP("HMPX",$JOB,DFN,TYPE,HMPID))
- if HMPID=""
- QUIT
- SET X=$GET(^(HMPID))
- Begin DoDot:3
- +19 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
- +20 SET $ETRAP="D ERRHDLR^HMPDERRH"
- SET ERRPAT=DFN
- +21 SET ERRMSG="A problem occurred when trying to refresh patient data from an API."
- +22 ;
- +23 IF X="@"
- DO DELETE(TYPE,DFN,HMPID)
- QUIT
- +24 ;creates @HMP@(HMPI+1)
- SET HMPLASTI=HMPI
- DO @RTN
- +25 ;
- +26 ; if no new item, assume the record has been deleted
- +27 IF HMPI'>HMPLASTI
- DO DELETE(TYPE,DFN,HMPID)
- QUIT
- +28 SET HMPTOTL=HMPTOTL+1
- SET DATA=1
- End DoDot:3
- +29 ;no data, or error
- IF 'HMPI
- SET DOMCNT=DOMCNT-1
- QUIT
- +30 ;
- +31 if DOMCNT>1
- SET @HMP@(.3)=","
- +32 SET @HMP@(.5)="{""domainName"":"""_TYPE_""",""total"":"_HMPI_",""items"":["
- +33 SET HMPI=HMPI+1
- SET @HMP@(HMPI)="]}"
- End DoDot:2
- +34 ;
- A ; HMP=$NA(^TMP("HMP",$J)) again
- +1 if PATCNT>1
- SET @HMP@(PATCNT,.3)=","
- +2 SET @HMP@(PATCNT,.5)="{""patientDfn"":"_DFN_",""patientIcn"":"""_ICN_""""
- +3 IF DOMCNT
- Begin DoDot:2
- +4 SET @HMP@(PATCNT,.6)=",""domains"":["
- +5 SET DOMCNT=DOMCNT+1
- SET @HMP@(PATCNT,DOMCNT)="]"
- End DoDot:2
- +6 ;
- +7 IF $DATA(DELETE)
- Begin DoDot:2
- +8 SET DOMCNT=DOMCNT+1
- SET @HMP@(PATCNT,DOMCNT,.5)=",""deletes"":["
- +9 SET HMPI=0
- SET UID=""
- FOR
- SET UID=$ORDER(DELETE(UID))
- if UID=""
- QUIT
- Begin DoDot:3
- +10 SET TYPE=DELETE(UID)
- SET HMPI=HMPI+1
- +11 if HMPI>1
- SET @HMP@(PATCNT,DOMCNT,HMPI,.3)=","
- +12 SET @HMP@(PATCNT,DOMCNT,HMPI,1)="{""uid"":"""_UID_""",""domainName"":"""_TYPE_"""}"
- End DoDot:3
- +13 SET HMPI=HMPI+1
- SET @HMP@(PATCNT,DOMCNT,HMPI)="]"
- End DoDot:2
- +14 ;
- +15 IF $DATA(^TMP($JOB,"HMP ERROR"))
- Begin DoDot:2
- +16 NEW ERROR
- DO BUILDERR^HMPDJ(.ERROR)
- +17 SET DOMCNT=DOMCNT+1
- SET @HMP@(PATCNT,DOMCNT,.3)=","
- +18 MERGE @HMP@(PATCNT,DOMCNT)=ERROR
- +19 KILL ^TMP($JOB,"HMP ERROR")
- End DoDot:2
- +20 ;
- +21 SET DOMCNT=DOMCNT+1
- SET @HMP@(PATCNT,DOMCNT)="}"
- End DoDot:1
- +22 ;
- +23 SET Y=$GET(^TMP("HMPX",$JOB,0))
- if Y=""
- SET Y=LAST
- +24 SET T=$$NOW^XLFDT()
- +25 SET @HMP@(.5)="{""apiVersion"":""1.01"",""data"":{""lastUpdate"":"""_Y_""",""startDateTime"":"""_TSTART_""",""totalPatients"":"_PATCNT
- +26 if PATCNT
- SET @HMP@(.6)=",""patients"":["
- SET PATCNT=PATCNT+1
- SET @HMP@(PATCNT)="]"
- +27 ;
- B ;
- +1 ;operational data
- IF $DATA(^TMP("HMPX",$JOB,"OP"))
- Begin DoDot:1
- +2 SET (HMPTOTL,DOMCNT)=0
- SET PATCNT=PATCNT+1
- KILL DATA,DELETE
- +3 SET TYPE=""
- FOR
- SET TYPE=$ORDER(^TMP("HMPX",$JOB,"OP",TYPE))
- if TYPE=""
- QUIT
- Begin DoDot:2
- +4 SET RTN=$$TAG^HMPEF(TYPE)_"^HMPEF"
- if '$LENGTH($TEXT(@RTN))
- QUIT
- +5 SET DOMCNT=DOMCNT+1
- SET DFN=""
- +6 ;
- +7 NEW HMP
- SET HMP=$NAME(^TMP("HMP",$JOB,PATCNT,DOMCNT))
- SET HMPI=0
- SET HMPID=""
- +8 FOR
- SET HMPID=$ORDER(^TMP("HMPX",$JOB,"OP",TYPE,HMPID))
- if HMPID=""
- QUIT
- SET X=$GET(^(HMPID))
- Begin DoDot:3
- +9 IF X="@"
- DO DELETE(TYPE,DFN,HMPID)
- QUIT
- +10 ;creates @HMP@(HMPI+1)
- SET HMPLASTI=HMPI
- DO @RTN
- +11 ; if no new item, assume the record has been deleted
- +12 IF HMPI'>HMPLASTI
- DO DELETE(TYPE,DFN,HMPID)
- QUIT
- +13 SET HMPTOTL=HMPTOTL+1
- SET DATA=1
- End DoDot:3
- +14 ;no data, or error
- IF 'HMPI
- SET DOMCNT=DOMCNT-1
- QUIT
- +15 ;
- +16 if DOMCNT>1
- SET @HMP@(.3)=","
- +17 SET @HMP@(.5)="{""domainName"":"""_TYPE_""",""total"":"_HMPI_",""items"":["
- +18 SET HMPI=HMPI+1
- SET @HMP@(HMPI)="]}"
- End DoDot:2
- +19 ;
- C ; HMP=$NA(^TMP("HMP",$J)) again
- +1 ;no data, or error
- IF 'DOMCNT
- IF '$DATA(DELETE)
- QUIT
- +2 SET @HMP@(PATCNT,.5)=",""operational"":{"
- +3 IF DOMCNT
- Begin DoDot:2
- +4 SET @HMP@(PATCNT,.6)="""domains"":["
- +5 SET DOMCNT=DOMCNT+1
- SET @HMP@(PATCNT,DOMCNT)="]"
- End DoDot:2
- +6 ;
- +7 IF $DATA(DELETE)
- Begin DoDot:2
- +8 SET DOMCNT=DOMCNT+1
- if DOMCNT>1
- SET @HMP@(PATCNT,DOMCNT,.3)=","
- +9 SET @HMP@(PATCNT,DOMCNT,.5)="""deletes"":["
- +10 SET HMPI=0
- SET UID=""
- FOR
- SET UID=$ORDER(DELETE(UID))
- if UID=""
- QUIT
- Begin DoDot:3
- +11 SET TYPE=DELETE(UID)
- SET HMPI=HMPI+1
- +12 if HMPI>1
- SET @HMP@(PATCNT,DOMCNT,HMPI,.3)=","
- +13 SET @HMP@(PATCNT,DOMCNT,HMPI,1)="{""uid"":"""_UID_""",""domainName"":"""_TYPE_"""}"
- End DoDot:3
- +14 SET HMPI=HMPI+1
- SET @HMP@(PATCNT,DOMCNT,HMPI)="]"
- End DoDot:2
- +15 ;
- +16 SET DOMCNT=DOMCNT+1
- SET @HMP@(PATCNT,DOMCNT)="}"
- End DoDot:1
- +17 ;
- +18 SET TSTOP=$$NOW^XLFDT()
- +19 ;close JSON
- SET PATCNT=PATCNT+1
- SET @HMP@(PATCNT)=",""endDateTime"":"""_TSTOP_"""}}"
- +20 KILL ^TMP("HMPX",$JOB),^TMP("HMPTEXT",$JOB)
- +21 QUIT
- +22 ;
- DELETE(NAME,DFN,ID) ; -- set DELETE nodes
- +1 NEW UID
- +2 SET UID=$$SETUID^HMPUTILS(NAME,DFN,ID)
- +3 SET DELETE(UID)=NAME
- +4 QUIT
- +5 ;
- GETLIST(LAST,SYS,MAX) ; -- build list of updates for client
- +1 ; Returns ^TMP("HMPX",$J,0) = last DATE:SEQ included
- +2 ; ^TMP("HMPX",$J,DFN,TYPE,ID)=ACT
- +3 NEW DATE,SEQ,DA,END,IDX,X0,DFN,TYPE,ID,ACT,D,N,CNT
- +4 KILL ^TMP("HMPX",$JOB)
- +5 SET DATE=+LAST
- SET SEQ=+$PIECE(LAST,":",2)
- SET CNT=0
- +6 SET DA=$$FIND^HMPPATS(SYS)
- if 'DA
- QUIT
- +7 ;
- +8 ; generate list ID, and end point
- +9 ;last entry, as of now
- SET D=DT
- SET N=+$ORDER(^XTMP("HMP-"_DT,"A"),-1)
- +10 ;no new items
- IF DATE=DT
- IF SEQ=N
- SET ^TMP("HMPX",$JOB,0)=LAST
- QUIT
- +11 ;
- +12 ;init loop where left off
- SET IDX=$NAME(^XTMP("HMP-"_DATE,SEQ))
- SET END=N
- +13 FOR
- SET IDX=$QUERY(@IDX)
- if $$DONE
- QUIT
- Begin DoDot:1
- +14 SET D=+$PIECE(IDX,"-",2)
- SET N=+$PIECE(IDX,",",2)
- +15 SET X0=@IDX
- SET DFN=$PIECE(X0,U)
- if DFN=""
- SET DFN="OP"
- +16 IF DFN
- IF '$DATA(^HMP(800000,"ADFN",DFN,DA))
- QUIT
- +17 SET TYPE=$PIECE(X0,U,2)
- SET ID=$PIECE(X0,U,3)
- SET ACT=$PIECE(X0,U,4)
- +18 ;error
- IF TYPE=""!(ID="")
- QUIT
- +19 IF TYPE="ROSTER"
- IF '$DATA(^HMP(800000,"AROS",ID,DA))
- QUIT
- +20 if '$DATA(^TMP("HMPX",$JOB,DFN,TYPE,ID))
- SET CNT=CNT+1
- +21 SET ^TMP("HMPX",$JOB,DFN,TYPE,ID)=ACT
- End DoDot:1
- if CNT'<MAX
- QUIT
- +22 ;final date:seq
- SET ^TMP("HMPX",$JOB,0)=D_":"_N
- +23 QUIT
- +24 ;
- DONE() ; -- Return 1 or 0, if loop has finished
- +1 ;end of ^XTMP("HMP")
- IF IDX'?1"^XTMP(""HMP-"7N.E
- QUIT 1
- +2 NEW D,N
- SET D=+$PIECE(IDX,"-",2)
- SET N=+$PIECE(IDX,",",2)
- +3 ; check HMP-DATE subscript
- +4 ;prior day: keep going
- IF D<DT
- QUIT 0
- +5 ;next day: stop loop
- IF D>DT
- QUIT 1
- +6 ; D=DT: check sequence# subscript
- +7 IF N>END
- QUIT 1
- +8 QUIT 0