Routine: PXVWCCH

PXVWCCH ;ISP/LMT - ICE Cache Utilities ;Aug 23, 2021@11:28:52

 ;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134

STAT(DFN) ;

 N PXBUILDINGDT,PXNOW,PXPURGEDT,PXRETURN,PXSUB,PXVMRCHASH,PXVMRHASH

 S PXSUB=$$SUB(DFN)

 S PXNOW=$$NOW^XLFDT

 S PXRETURN=0

 I '$D(^XTMP(PXSUB)) Q PXRETURN

 S PXPURGEDT=$P($G(^XTMP(PXSUB,0)),U,1)

 I (PXPURGEDT<PXNOW)!('$D(^XTMP(PXSUB,"VMR")))!('$D(^XTMP(PXSUB,"ICE"))) D  Q PXRETURN

 . S PXBUILDINGDT=$G(^XTMP(PXSUB,"BUILDING"))

 . I PXBUILDINGDT,$$HDIFF^XLFDT($H,PXBUILDINGDT,2)<21 D  Q

 . . S PXRETURN=2

 . D PURGE(DFN)

 S PXVMRHASH=$$HASH^PXVWVMR

 S PXVMRCHASH=$G(^XTMP(PXSUB,"VMR","HASH"))

 I PXVMRHASH'="",PXVMRHASH=PXVMRCHASH D  Q PXRETURN

 . S ^XTMP(PXSUB,"DT")=PXNOW

 . S PXRETURN=1

 Q PXRETURN

EXIST(DFN) ;

 N PXPURGEDT,PXSUB

 S PXSUB=$$SUB(DFN)

 S PXPURGEDT=$P($G(^XTMP(PXSUB,0)),U,1)

 Q $$NOW^XLFDT()<PXPURGEDT

LOAD(DFN) ;

 N PXSUB

 S PXSUB=$$SUB(DFN)

 M ^TMP("PXICEWEB",$J)=^XTMP(PXSUB,"ICE")

BLDNG(DFN) ;Set flag that cache is in middle of building

 N PXSUB

 S PXSUB=$$SUB(DFN)

 I '$D(^XTMP(PXSUB,0)) D

 . S ^XTMP(PXSUB,0)=DT_".24"_U_($H)_U_"ICE Cache for "_DFN

 S ^XTMP(PXSUB,"BUILDING")=$H

ISBLDNG(DFN) ;

 N PXBUILDINGDT,PXRETURN,PXSUB

 S PXSUB=$$SUB(DFN)

 S PXRETURN=0

 S PXBUILDINGDT=$G(^XTMP(PXSUB,"BUILDING"))

 I PXBUILDINGDT,$$HDIFF^XLFDT($H,PXBUILDINGDT,2)<21 S PXRETURN=1

 Q PXRETURN

CLRBLDNG(DFN) ;

 N PXSUB

 S PXSUB=$$SUB(DFN)

 K ^XTMP(PXSUB,"BUILDING")

SAVE(DFN,PXCREATEDT) ;

 N PXBDAY,PXPURGEDT,PXSUB,PXVMRHASH

 S PXSUB=$$SUB(DFN)

 ; when ICE sends back version num (and purge cache when version chahnges), then set purge date to 24 days;

 ; except for: age<17 or birthday<24 days

 S PXPURGEDT=DT_".24"

 ;S PXBDAY=$$BDAY(DFN)

 ;I PXBDAY<PXPURGEDT S PXPURGEDT=PXBDAY

 S ^XTMP(PXSUB,0)=PXPURGEDT_U_PXCREATEDT_U_"ICE Cache for "_DFN

 S PXVMRHASH=$$HASH^PXVWVMR

 S ^XTMP(PXSUB,"VMR","HASH")=PXVMRHASH

 M ^XTMP(PXSUB,"ICE")=^TMP("PXICEWEB",$J)

 S ^XTMP(PXSUB,"DT")=PXCREATEDT

 K ^XTMP(PXSUB,"BUILDING")

PURGE(DFN) ;

 N PXSUB

 S PXSUB=$$SUB(DFN)

 K ^XTMP(PXSUB)

SUB(DFN) ;

 Q "PXVWICE-"_DFN

UPDATE ; Update cache for patients with upcoming appointments or admissions

 ; ZEXCEPT: ZTREQ

 S ZTREQ="@"

 N DFN,PXCHKCACHE,PXDT,PXMIDNIGHT,PXNOW,PXPURGEDT,PXRETURN,PXSUB

 K ^TMP("PXVWCCH-DFN",$J)

 S PXNOW=$$NOW^XLFDT

 S PXMIDNIGHT=DT_".24"

 D GETLIST(PXNOW)

 S PXDT=0

 F  S PXDT=$O(^TMP("PXVWCCH-DFN",$J,PXDT)) Q:'PXDT  D

 . S DFN=0

 . F  S DFN=$O(^TMP("PXVWCCH-DFN",$J,PXDT,DFN)) Q:'DFN  D

 . . S PXSUB=$$SUB(DFN)

 . . S PXPURGEDT=$P($G(^XTMP(PXSUB,0)),U,1)

 . . S PXCHKCACHE=1

 . . ; if cache is expiring before midnight, then force update to cache

 . . I PXPURGEDT<PXMIDNIGHT S PXCHKCACHE=0

 . . D EN^PXVWICE(.PXRETURN,DFN,PXCHKCACHE,1)

 I $G(PXRETURN)'="" K @PXRETURN

 K ^TMP("PXVWCCH-DFN",$J)

GETLIST(PXNOW) ; get list of patients with upcoming appoitments or admissions

 N PXDT,PXHR,PXLISTDT,PXTIME

 S PXDT=$P(PXNOW,".",1)

 S PXTIME=$P(PXNOW,".",2)

 S PXHR=$E(PXTIME,1,2)

 ; Get tomorrow's appointments/admissions

 ;S PXLISTDT=$$FMADD^XLFDT(PXDT,1)

 ; If running before 8am, get today's appointments/admissions

 ; TODO: what time should cut-off be?

 ;I PXHR<8 S PXLISTDT=PXDT

 S PXLISTDT=PXDT

 D GETAPPT(PXLISTDT)

 D GETADM(PXLISTDT)

 D GETINP

 K ^TMP("PXVWCCH-DFN",$J,"C")

GETAPPT(PXAPPTDT) ; get upcoming appointments

 N DFN,PXARRAY,PXCOUNT,PXSTOPCODES

 K ^TMP($J,"SDAMA301")

 S PXARRAY(1)=PXAPPTDT_";"_PXAPPTDT

 S PXARRAY(3)="R;I"

 S PXSTOPCODES=$$GET^XPAR("ALL","PXV ICE WEB STOP CODE FILTER")

 I PXSTOPCODES'="" S PXARRAY(13)=PXSTOPCODES

 S PXARRAY("FLDS")="1;2;3;10;13"

 S PXARRAY("SORT")="P"

 S PXCOUNT=$$SDAPI^SDAMA301(.PXARRAY)

 S DFN=0

 F  S DFN=$O(^TMP($J,"SDAMA301",DFN)) Q:'DFN  D

 . S PXAPPTDT=$O(^TMP($J,"SDAMA301",DFN,0))

 . S ^TMP("PXVWCCH-DFN",$J,PXAPPTDT,DFN)=""

 . S ^TMP("PXVWCCH-DFN",$J,"C",DFN,PXAPPTDT)=""

 K ^TMP($J,"SDAMA301")

GETADM(PXADMDT) ; get scheduled admissions

 N DFN,PXDT,PXENDDT,PXIEN,PXNODE,PXRESDT

 ; TOTO: get ICR for 41.1 (perhaps subscribe to ICR #429)

 S PXENDDT=PXADMDT_".24"

 S PXRESDT=PXADMDT-.0000001

 F  S PXRESDT=$O(^DGS(41.1,"C",PXRESDT)) Q:(('PXRESDT)!(PXRESDT>PXENDDT))  D

 . S PXIEN=0

 . F  S PXIEN=$O(^DGS(41.1,"C",PXRESDT,PXIEN)) Q:'PXIEN  D

 . . S PXNODE=$G(^DGS(41.1,PXIEN,0))

 . . I $P(PXNODE,U,13) Q  ;cancelled

 . . S DFN=$P(PXNODE,U,1)

 . . I $D(^TMP("PXVWCCH-DFN",$J,"C",DFN)) D  Q:'PXRESDT

 . . . S PXDT=$O(^TMP("PXVWCCH-DFN",$J,"C",DFN,0))

 . . . I PXDT<PXRESDT S PXRESDT=0 Q

 . . . K ^TMP("PXVWCCH-DFN",$J,PXDT,DFN)

 . . . K ^TMP("PXVWCCH-DFN",$J,"C",DFN,PXDT)

 . . S ^TMP("PXVWCCH-DFN",$J,PXRESDT,DFN)=""

 . . S ^TMP("PXVWCCH-DFN",$J,"C",DFN,PXRESDT)=""

GETINP ; get current inpatients

 N DFN,PXWARD

 S PXWARD=""

 F  S PXWARD=$O(^DPT("CN",PXWARD)) Q:PXWARD=""  D  ;ICR #10035

 . S DFN=0 F  S DFN=$O(^DPT("CN",PXWARD,DFN)) Q:'DFN  D

 . . I $D(^TMP("PXVWCCH-DFN",$J,"C",DFN)) Q

 . . S ^TMP("PXVWCCH-DFN",$J,DT,DFN)=""

UPDPAT(PXRETURN,DFN) ;Check, and if needed update, the cache for a given patient

 N PXCREATEDT,PXLASTDT,PXSUB,PXTASK,PXVOTH

 S PXRETURN=1

 S PXSUB=$$SUB(DFN)

 S PXLASTDT=$G(^XTMP(PXSUB,"DT"))

 ; If cache was already validated today, no need to update it again.

 I $P(PXLASTDT,".",1)=DT Q

 S PXVOTH("ZTDTH")=$H

 S PXTASK=$$NODEV^XUTMDEVQ("UPDPTTSK^PXVWCCH","Update ICE Cache for DFN "_DFN,"DFN",.PXVOTH)

UPDPTTSK ; Tasked job to update cache

 ; ZEXCEPT: DFN,ZTREQ

 S ZTREQ="@"

 N PXCHKCACHE,PXPURGEDT,PXRETURN,PXSUB

 S PXSUB=$$SUB(DFN)

 S PXPURGEDT=$P($G(^XTMP(PXSUB,0)),U,1)

 S PXCHKCACHE=1

 ; if cache is expiring before midnight, then force update to cache

 I PXPURGEDT<(DT_".24") S PXCHKCACHE=0

 D EN^PXVWICE(.PXRETURN,DFN,PXCHKCACHE,1)

 I $G(PXRETURN)'="" K @PXRETURN

AGE(DFN) ; Patient's age

 N VADM,VAHOW,VAPTYP,VAROOT

 D DEM^VADPT

 Q VADM(4)

BDAY(DFN) ; Patient's next birthday

 N PXDOB,PXDT,PXYR,VADM,VAHOW,VAPTYP,VAROOT

 D DEM^VADPT

 S PXDOB=$P(VADM(3),U,1)

 S PXDT=$$DT^XLFDT

 S PXYR=$E(PXDT,1,3)+1

 I $E(PXDOB,4,7)>$E(PXDT,4,7) S PXYR=$E(PXDT,1,3)

 Q PXYR_$E(PXDOB,4,7)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXVWCCH   6562     printed  Feb 18, 2025@23:58:30                                                                                                                                                                                                     Page 2

PXVWCCH   ;ISP/LMT - ICE Cache Utilities ;Aug 23, 2021@11:28:52

 +1       ;;1.0;PCE PATIENT CARE ENCOUNTER;**217**;Aug 12, 1996;Build 134

 +2       ;

 +3       ;

STAT(DFN) ;

 +1       ;

 +2        NEW PXBUILDINGDT,PXNOW,PXPURGEDT,PXRETURN,PXSUB,PXVMRCHASH,PXVMRHASH

 +3       ;

 +4        SET PXSUB=$$SUB(DFN)

 +5        SET PXNOW=$$NOW^XLFDT

 +6        SET PXRETURN=0

 +7       ;

 +8        IF '$DATA(^XTMP(PXSUB))

               QUIT PXRETURN

 +9       ;

 +10       SET PXPURGEDT=$PIECE($GET(^XTMP(PXSUB,0)),U,1)

 +11       IF (PXPURGEDT<PXNOW)!('$DATA(^XTMP(PXSUB,"VMR")))!('$DATA(^XTMP(PXSUB,"ICE")))

               Begin DoDot:1

 +12               SET PXBUILDINGDT=$GET(^XTMP(PXSUB,"BUILDING"))

 +13               IF PXBUILDINGDT

                       IF $$HDIFF^XLFDT($HOROLOG,PXBUILDINGDT,2)<21

                           Begin DoDot:2

 +14                           SET PXRETURN=2

                           End DoDot:2

                           QUIT

 +15               DO PURGE(DFN)

               End DoDot:1

               QUIT PXRETURN

 +16      ;

 +17       SET PXVMRHASH=$$HASH^PXVWVMR

 +18       SET PXVMRCHASH=$GET(^XTMP(PXSUB,"VMR","HASH"))

 +19       IF PXVMRHASH'=""

               IF PXVMRHASH=PXVMRCHASH

                   Begin DoDot:1

 +20                   SET ^XTMP(PXSUB,"DT")=PXNOW

 +21                   SET PXRETURN=1

                   End DoDot:1

                   QUIT PXRETURN

 +22      ;

 +23       QUIT PXRETURN

 +24      ;

 +25      ;

EXIST(DFN) ;

 +1       ;

 +2        NEW PXPURGEDT,PXSUB

 +3       ;

 +4        SET PXSUB=$$SUB(DFN)

 +5       ;

 +6        SET PXPURGEDT=$PIECE($GET(^XTMP(PXSUB,0)),U,1)

 +7       ;

 +8        QUIT $$NOW^XLFDT()<PXPURGEDT

 +9       ;

 +10      ;

LOAD(DFN) ;

 +1       ;

 +2        NEW PXSUB

 +3       ;

 +4        SET PXSUB=$$SUB(DFN)

 +5       ;

 +6        MERGE ^TMP("PXICEWEB",$JOB)=^XTMP(PXSUB,"ICE")

 +7       ;

 +8        QUIT

 +9       ;

 +10      ;

BLDNG(DFN) ;Set flag that cache is in middle of building

 +1       ;

 +2        NEW PXSUB

 +3       ;

 +4        SET PXSUB=$$SUB(DFN)

 +5       ;

 +6        IF '$DATA(^XTMP(PXSUB,0))

               Begin DoDot:1

 +7                SET ^XTMP(PXSUB,0)=DT_".24"_U_($HOROLOG)_U_"ICE Cache for "_DFN

               End DoDot:1

 +8       ;

 +9        SET ^XTMP(PXSUB,"BUILDING")=$HOROLOG

 +10      ;

 +11       QUIT

 +12      ;

 +13      ;

ISBLDNG(DFN) ;

 +1       ;

 +2        NEW PXBUILDINGDT,PXRETURN,PXSUB

 +3       ;

 +4        SET PXSUB=$$SUB(DFN)

 +5        SET PXRETURN=0

 +6       ;

 +7        SET PXBUILDINGDT=$GET(^XTMP(PXSUB,"BUILDING"))

 +8        IF PXBUILDINGDT

               IF $$HDIFF^XLFDT($HOROLOG,PXBUILDINGDT,2)<21

                   SET PXRETURN=1

 +9       ;

 +10       QUIT PXRETURN

 +11      ;

 +12      ;

CLRBLDNG(DFN) ;

 +1       ;

 +2        NEW PXSUB

 +3       ;

 +4        SET PXSUB=$$SUB(DFN)

 +5        KILL ^XTMP(PXSUB,"BUILDING")

 +6       ;

 +7        QUIT

 +8       ;

 +9       ;

SAVE(DFN,PXCREATEDT) ;

 +1       ;

 +2        NEW PXBDAY,PXPURGEDT,PXSUB,PXVMRHASH

 +3       ;

 +4        SET PXSUB=$$SUB(DFN)

 +5       ;

 +6       ; when ICE sends back version num (and purge cache when version chahnges), then set purge date to 24 days;

 +7       ; except for: age<17 or birthday<24 days

 +8        SET PXPURGEDT=DT_".24"

 +9       ;S PXBDAY=$$BDAY(DFN)

 +10      ;I PXBDAY<PXPURGEDT S PXPURGEDT=PXBDAY

 +11      ;

 +12       SET ^XTMP(PXSUB,0)=PXPURGEDT_U_PXCREATEDT_U_"ICE Cache for "_DFN

 +13      ;

 +14       SET PXVMRHASH=$$HASH^PXVWVMR

 +15       SET ^XTMP(PXSUB,"VMR","HASH")=PXVMRHASH

 +16      ;

 +17       MERGE ^XTMP(PXSUB,"ICE")=^TMP("PXICEWEB",$JOB)

 +18      ;

 +19       SET ^XTMP(PXSUB,"DT")=PXCREATEDT

 +20      ;

 +21       KILL ^XTMP(PXSUB,"BUILDING")

 +22      ;

 +23       QUIT

 +24      ;

 +25      ;

PURGE(DFN) ;

 +1       ;

 +2        NEW PXSUB

 +3       ;

 +4        SET PXSUB=$$SUB(DFN)

 +5        KILL ^XTMP(PXSUB)

 +6       ;

 +7        QUIT

 +8       ;

 +9       ;

SUB(DFN)  ;

 +1        QUIT "PXVWICE-"_DFN

 +2       ;

 +3       ;

UPDATE    ; Update cache for patients with upcoming appointments or admissions

 +1       ;

 +2       ; ZEXCEPT: ZTREQ

 +3       ;

 +4        SET ZTREQ="@"

 +5        NEW DFN,PXCHKCACHE,PXDT,PXMIDNIGHT,PXNOW,PXPURGEDT,PXRETURN,PXSUB

 +6       ;

 +7        KILL ^TMP("PXVWCCH-DFN",$JOB)

 +8       ;

 +9        SET PXNOW=$$NOW^XLFDT

 +10       SET PXMIDNIGHT=DT_".24"

 +11       DO GETLIST(PXNOW)

 +12      ;

 +13       SET PXDT=0

 +14       FOR

               SET PXDT=$ORDER(^TMP("PXVWCCH-DFN",$JOB,PXDT))

               if 'PXDT

                   QUIT

               Begin DoDot:1

 +15               SET DFN=0

 +16               FOR

                       SET DFN=$ORDER(^TMP("PXVWCCH-DFN",$JOB,PXDT,DFN))

                       if 'DFN

                           QUIT

                       Begin DoDot:2

 +17                       SET PXSUB=$$SUB(DFN)

 +18                       SET PXPURGEDT=$PIECE($GET(^XTMP(PXSUB,0)),U,1)

 +19                       SET PXCHKCACHE=1

 +20      ; if cache is expiring before midnight, then force update to cache

 +21                       IF PXPURGEDT<PXMIDNIGHT

                               SET PXCHKCACHE=0

 +22                       DO EN^PXVWICE(.PXRETURN,DFN,PXCHKCACHE,1)

                       End DoDot:2

               End DoDot:1

 +23      ;

 +24       IF $GET(PXRETURN)'=""

               KILL @PXRETURN

 +25       KILL ^TMP("PXVWCCH-DFN",$JOB)

 +26      ;

 +27       QUIT

 +28      ;

 +29      ;

GETLIST(PXNOW) ; get list of patients with upcoming appoitments or admissions

 +1       ;

 +2        NEW PXDT,PXHR,PXLISTDT,PXTIME

 +3       ;

 +4        SET PXDT=$PIECE(PXNOW,".",1)

 +5        SET PXTIME=$PIECE(PXNOW,".",2)

 +6        SET PXHR=$EXTRACT(PXTIME,1,2)

 +7       ; Get tomorrow's appointments/admissions

 +8       ;S PXLISTDT=$$FMADD^XLFDT(PXDT,1)

 +9       ; If running before 8am, get today's appointments/admissions

 +10      ; TODO: what time should cut-off be?

 +11      ;I PXHR<8 S PXLISTDT=PXDT

 +12       SET PXLISTDT=PXDT

 +13      ;

 +14       DO GETAPPT(PXLISTDT)

 +15       DO GETADM(PXLISTDT)

 +16       DO GETINP

 +17       KILL ^TMP("PXVWCCH-DFN",$JOB,"C")

 +18       QUIT

 +19      ;

GETAPPT(PXAPPTDT) ; get upcoming appointments

 +1       ;

 +2        NEW DFN,PXARRAY,PXCOUNT,PXSTOPCODES

 +3       ;

 +4        KILL ^TMP($JOB,"SDAMA301")

 +5       ;

 +6        SET PXARRAY(1)=PXAPPTDT_";"_PXAPPTDT

 +7        SET PXARRAY(3)="R;I"

 +8        SET PXSTOPCODES=$$GET^XPAR("ALL","PXV ICE WEB STOP CODE FILTER")

 +9        IF PXSTOPCODES'=""

               SET PXARRAY(13)=PXSTOPCODES

 +10       SET PXARRAY("FLDS")="1;2;3;10;13"

 +11       SET PXARRAY("SORT")="P"

 +12       SET PXCOUNT=$$SDAPI^SDAMA301(.PXARRAY)

 +13      ;

 +14       SET DFN=0

 +15       FOR

               SET DFN=$ORDER(^TMP($JOB,"SDAMA301",DFN))

               if 'DFN

                   QUIT

               Begin DoDot:1

 +16               SET PXAPPTDT=$ORDER(^TMP($JOB,"SDAMA301",DFN,0))

 +17               SET ^TMP("PXVWCCH-DFN",$JOB,PXAPPTDT,DFN)=""

 +18               SET ^TMP("PXVWCCH-DFN",$JOB,"C",DFN,PXAPPTDT)=""

               End DoDot:1

 +19      ;

 +20       KILL ^TMP($JOB,"SDAMA301")

 +21      ;

 +22       QUIT

 +23      ;

GETADM(PXADMDT) ; get scheduled admissions

 +1       ;

 +2        NEW DFN,PXDT,PXENDDT,PXIEN,PXNODE,PXRESDT

 +3       ;

 +4       ; TOTO: get ICR for 41.1 (perhaps subscribe to ICR #429)

 +5        SET PXENDDT=PXADMDT_".24"

 +6        SET PXRESDT=PXADMDT-.0000001

 +7        FOR

               SET PXRESDT=$ORDER(^DGS(41.1,"C",PXRESDT))

               if (('PXRESDT)!(PXRESDT>PXENDDT))

                   QUIT

               Begin DoDot:1

 +8                SET PXIEN=0

 +9                FOR

                       SET PXIEN=$ORDER(^DGS(41.1,"C",PXRESDT,PXIEN))

                       if 'PXIEN

                           QUIT

                       Begin DoDot:2

 +10                       SET PXNODE=$GET(^DGS(41.1,PXIEN,0))

 +11      ;cancelled

                           IF $PIECE(PXNODE,U,13)

                               QUIT

 +12                       SET DFN=$PIECE(PXNODE,U,1)

 +13                       IF $DATA(^TMP("PXVWCCH-DFN",$JOB,"C",DFN))

                               Begin DoDot:3

 +14                               SET PXDT=$ORDER(^TMP("PXVWCCH-DFN",$JOB,"C",DFN,0))

 +15                               IF PXDT<PXRESDT

                                       SET PXRESDT=0

                                       QUIT

 +16                               KILL ^TMP("PXVWCCH-DFN",$JOB,PXDT,DFN)

 +17                               KILL ^TMP("PXVWCCH-DFN",$JOB,"C",DFN,PXDT)

                               End DoDot:3

                               if 'PXRESDT

                                   QUIT

 +18                       SET ^TMP("PXVWCCH-DFN",$JOB,PXRESDT,DFN)=""

 +19                       SET ^TMP("PXVWCCH-DFN",$JOB,"C",DFN,PXRESDT)=""

                       End DoDot:2

               End DoDot:1

 +20      ;

 +21       QUIT

 +22      ;

 +23      ;

GETINP    ; get current inpatients

 +1       ;

 +2        NEW DFN,PXWARD

 +3       ;

 +4        SET PXWARD=""

 +5       ;ICR #10035

FOR

               SET PXWARD=$ORDER(^DPT("CN",PXWARD))

               if PXWARD=""

                   QUIT

               Begin DoDot:1

 +6                SET DFN=0

FOR

                       SET DFN=$ORDER(^DPT("CN",PXWARD,DFN))

                       if 'DFN

                           QUIT

                       Begin DoDot:2

 +7                        IF $DATA(^TMP("PXVWCCH-DFN",$JOB,"C",DFN))

                               QUIT

 +8                        SET ^TMP("PXVWCCH-DFN",$JOB,DT,DFN)=""

                       End DoDot:2

               End DoDot:1

 +9        QUIT

 +10      ;

 +11      ;

UPDPAT(PXRETURN,DFN) ;Check, and if needed update, the cache for a given patient

 +1       ;

 +2        NEW PXCREATEDT,PXLASTDT,PXSUB,PXTASK,PXVOTH

 +3       ;

 +4        SET PXRETURN=1

 +5       ;

 +6        SET PXSUB=$$SUB(DFN)

 +7       ;

 +8        SET PXLASTDT=$GET(^XTMP(PXSUB,"DT"))

 +9       ; If cache was already validated today, no need to update it again.

 +10       IF $PIECE(PXLASTDT,".",1)=DT

               QUIT

 +11      ;

 +12       SET PXVOTH("ZTDTH")=$HOROLOG

 +13       SET PXTASK=$$NODEV^XUTMDEVQ("UPDPTTSK^PXVWCCH","Update ICE Cache for DFN "_DFN,"DFN",.PXVOTH)

 +14      ;

 +15       QUIT

 +16      ;

UPDPTTSK  ; Tasked job to update cache

 +1       ;

 +2       ; ZEXCEPT: DFN,ZTREQ

 +3       ;

 +4        SET ZTREQ="@"

 +5        NEW PXCHKCACHE,PXPURGEDT,PXRETURN,PXSUB

 +6       ;

 +7        SET PXSUB=$$SUB(DFN)

 +8        SET PXPURGEDT=$PIECE($GET(^XTMP(PXSUB,0)),U,1)

 +9        SET PXCHKCACHE=1

 +10      ; if cache is expiring before midnight, then force update to cache

 +11       IF PXPURGEDT<(DT_".24")

               SET PXCHKCACHE=0

 +12      ;

 +13       DO EN^PXVWICE(.PXRETURN,DFN,PXCHKCACHE,1)

 +14      ;

 +15       IF $GET(PXRETURN)'=""

               KILL @PXRETURN

 +16      ;

 +17       QUIT

 +18      ;

 +19      ;

AGE(DFN)  ; Patient's age

 +1        NEW VADM,VAHOW,VAPTYP,VAROOT

 +2        DO DEM^VADPT

 +3        QUIT VADM(4)

 +4       ;

BDAY(DFN) ; Patient's next birthday

 +1       ;

 +2        NEW PXDOB,PXDT,PXYR,VADM,VAHOW,VAPTYP,VAROOT

 +3       ;

 +4        DO DEM^VADPT

 +5        SET PXDOB=$PIECE(VADM(3),U,1)

 +6        SET PXDT=$$DT^XLFDT

 +7        SET PXYR=$EXTRACT(PXDT,1,3)+1

 +8        IF $EXTRACT(PXDOB,4,7)>$EXTRACT(PXDT,4,7)

               SET PXYR=$EXTRACT(PXDT,1,3)

 +9        QUIT PXYR_$EXTRACT(PXDOB,4,7)

PXVWCCH.m