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")
;
Q
;
;
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
;
Q
;
;
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")
;
Q
;
;
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")
;
Q
;
;
PURGE(DFN) ;
;
N PXSUB
;
S PXSUB=$$SUB(DFN)
K ^XTMP(PXSUB)
;
Q
;
;
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)
;
Q
;
;
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")
Q
;
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")
;
Q
;
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)=""
;
Q
;
;
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)=""
Q
;
;
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)
;
Q
;
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
;
Q
;
;
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 Dec 13, 2024@02:32:14 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)
