VAFCEHLM ;ALB/JLU,LTL-FILE UTILITIES FOR 391.98 ;12/07/00
;;5.3;Registration;**149,255,307,333,477**;Aug 13, 1993
;
;Reference to VTQ^MPIFSAQ supported by IA #2941
;
EN ; -- main entry point for VAFC EXCPT SUM SCR
;fix records stuck in 'being reviewed' status
S IEN=0 F S IEN=$O(^DGCN(391.98,"AST",5,IEN)) Q:'IEN D ;**255
. L +^DGCN(391.98,IEN,0):0 I '$T Q ;record is truly being reviewed
. S XX=$$EDIT^VAFCEHU1(IEN,"AR") ;change record to action required
. L -^DGCN(391.98,IEN,0)
L +^DGCN(391.98,"VAFC PDR PURGE"):0 I '$T W $C(7),!!,"The Purge Patient Data Reviews process is currently running." QUIT
L -^DGCN(391.98,"VAFC PDR PURGE")
D EN^VALM("VAFC EXCPT SUM SCR")
Q
;
HDR ; -- header code
N RGSTRNG
S RGSTRNG="Review(s) currently on file."
S VALMHDR(1)=$$CENTER(RGSTRNG)
Q
;
INIT ; -- init variables and list array
;checking for sort variable
N XQORNOD
I '$D(VAFCSORT) S VAFCSORT="SN"
;
INIT2 ;enter at this point to reset the screens after editing etc.
K @VALMAR
D SORTS^VAFCEHU2(VAFCSORT,VALMAR)
D FORMAT^VAFCEHU2(VALMAR,.VALMCNT,.VALMQUIT)
Q
;
HELP ; -- help code
S X="?",VALMSG="Select patient for detailed display or change sorting"
D DISP^XQORM1 W !!
Q
;
EXIT ; -- exit code
K @VALMAR,VAFCSORT
Q
;
EXPND ; -- expand code
Q
;
SACT D HDR
D INIT
S VALMBCK="R"
Q
;
FULL S VALMSG="** = Different, -> = Edited, <UR> = Unresolved" D REVFUL^VAFCEHU2
S VALMBCK="R"
Q
;
DIFF S VALMBCK="R"
Q
;
INQ ; Patient Inquiry ;**255
N DFN
S DFN=+$P($G(^DGCN(391.98,IENPDR,0)),"^",1) ;**477
S VALMBCK=""
D FULL^VALM1
D EN^DGRPD
D PAUSE^VALM1
S VALMBCK="R"
Q
;
DISP ; Display Only Query to MPI ;**307
S VALMBCK=""
D FULL^VALM1
S MPIVAR("DFN")=$P(EXCPT,"^",1)
S MPIVAR("SSN")=$P($G(^DPT(+$P(EXCPT,"^",1),0)),"^",9)
S MPIVAR("NM")=$P($G(^DPT(+$P(EXCPT,"^",1),0)),"^",1)
S MPIVAR("DOB")=$P($P($G(^DPT(+$P(EXCPT,"^",1),0)),"^",3),".",1)
D VTQ^MPIFSAQ(.MPIVAR)
D PAUSE^VALM1
S VALMBCK="R"
K MPIVAR
Q
;
PDAT ;report to list CMOR, TF's & SUB's ;**333
N DFN
S DFN=+$P($G(^DGCN(391.98,IEN,0)),"^",1)
S VALMBCK=""
D FULL^VALM1
D START^VAFCPDAT
;D PAUSE^VALM1
S VALMBCK="R"
Q
;
CENTER(STRG) ;
;
N LEN,FIL,FIL1
S LEN=80-$L(STRG)
S FIL=LEN/2
S $P(FIL1," ",FIL)=""
Q FIL1_STRG
;
PDRPRG ;Purge PDRs ;**477
L +^DGCN(391.98,"VAFC PDR PURGE"):0 I '$T W $C(7),!!,"The Purge Patient Data Reviews process is currently running." Q
L -^DGCN(391.98,"VAFC PDR PURGE")
N TDATE,MAXDT,PDATE,X1,X2,X,Y
S NDATE=""
D NOW^%DTC S TDATE=X
S X1=TDATE,X2=-30 D C^%DTC
S (Y,MAXDT)=X D DD^%DT S PDATE=Y
S DIR("?")="Enter a date at least 30 days in the past."
S DIR("A")="Purge all Patient Data Reviews prior to "
S DIR("B")=PDATE,DIR(0)="DAO^:"_MAXDT_":EPX" D ^DIR K DIR Q:$D(DIRUT)
S NDATE=Y
S DIR(0)="YA",DIR("B")="NO"
S DIR("A")="Are you sure you want to purge Patient Data Reviews? " D ^DIR K DIR Q:$D(DIRUT)
Q:Y=0
;
N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTREQ
S ZTRTN="QPRG^VAFCEHLM",ZTDESC="PURGE PATIENT DATA REVIEWS OVER 30 DAYS OLD OR X DAYS OLD AS SPECIFIED BY USER."
D NOW^%DTC
S ZTIO="",ZTDTH=%
I $D(DUZ) S ZTSAVE("DUZ")=DUZ,ZTSAVE("NDATE")=NDATE
D ^%ZTLOAD
W !!?15,"Patient Data Review Purge Queued, Task #"_ZTSK
D HOME^%ZIS K IO("Q")
Q
QPRG ;
I $D(ZTQUEUED) S ZTREQ="@"
L +^DGCN(391.98,"VAFC PDR PURGE"):0 I '$T Q
N PDR,EVTDT,ERR S PDR=0,EVTDT=""
F S EVTDT=$O(^DGCN(391.98,"EVT",EVTDT)) Q:EVTDT>NDATE D
. F S PDR=$O(^DGCN(391.98,"EVT",EVTDT,PDR)) Q:'PDR D
.. S ERR=$$DELEXCPT^VAFCEHU1(PDR)
L -^DGCN(391.98,"VAFC PDR PURGE")
K NDATE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVAFCEHLM 3650 printed Oct 16, 2024@19:02:10 Page 2
VAFCEHLM ;ALB/JLU,LTL-FILE UTILITIES FOR 391.98 ;12/07/00
+1 ;;5.3;Registration;**149,255,307,333,477**;Aug 13, 1993
+2 ;
+3 ;Reference to VTQ^MPIFSAQ supported by IA #2941
+4 ;
EN ; -- main entry point for VAFC EXCPT SUM SCR
+1 ;fix records stuck in 'being reviewed' status
+2 ;**255
SET IEN=0
FOR
SET IEN=$ORDER(^DGCN(391.98,"AST",5,IEN))
if 'IEN
QUIT
Begin DoDot:1
+3 ;record is truly being reviewed
LOCK +^DGCN(391.98,IEN,0):0
IF '$TEST
QUIT
+4 ;change record to action required
SET XX=$$EDIT^VAFCEHU1(IEN,"AR")
+5 LOCK -^DGCN(391.98,IEN,0)
End DoDot:1
+6 LOCK +^DGCN(391.98,"VAFC PDR PURGE"):0
IF '$TEST
WRITE $CHAR(7),!!,"The Purge Patient Data Reviews process is currently running."
QUIT
+7 LOCK -^DGCN(391.98,"VAFC PDR PURGE")
+8 DO EN^VALM("VAFC EXCPT SUM SCR")
+9 QUIT
+10 ;
HDR ; -- header code
+1 NEW RGSTRNG
+2 SET RGSTRNG="Review(s) currently on file."
+3 SET VALMHDR(1)=$$CENTER(RGSTRNG)
+4 QUIT
+5 ;
INIT ; -- init variables and list array
+1 ;checking for sort variable
+2 NEW XQORNOD
+3 IF '$DATA(VAFCSORT)
SET VAFCSORT="SN"
+4 ;
INIT2 ;enter at this point to reset the screens after editing etc.
+1 KILL @VALMAR
+2 DO SORTS^VAFCEHU2(VAFCSORT,VALMAR)
+3 DO FORMAT^VAFCEHU2(VALMAR,.VALMCNT,.VALMQUIT)
+4 QUIT
+5 ;
HELP ; -- help code
+1 SET X="?"
SET VALMSG="Select patient for detailed display or change sorting"
+2 DO DISP^XQORM1
WRITE !!
+3 QUIT
+4 ;
EXIT ; -- exit code
+1 KILL @VALMAR,VAFCSORT
+2 QUIT
+3 ;
EXPND ; -- expand code
+1 QUIT
+2 ;
SACT DO HDR
+1 DO INIT
+2 SET VALMBCK="R"
+3 QUIT
+4 ;
FULL SET VALMSG="** = Different, -> = Edited, <UR> = Unresolved"
DO REVFUL^VAFCEHU2
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
DIFF SET VALMBCK="R"
+1 QUIT
+2 ;
INQ ; Patient Inquiry ;**255
+1 NEW DFN
+2 ;**477
SET DFN=+$PIECE($GET(^DGCN(391.98,IENPDR,0)),"^",1)
+3 SET VALMBCK=""
+4 DO FULL^VALM1
+5 DO EN^DGRPD
+6 DO PAUSE^VALM1
+7 SET VALMBCK="R"
+8 QUIT
+9 ;
DISP ; Display Only Query to MPI ;**307
+1 SET VALMBCK=""
+2 DO FULL^VALM1
+3 SET MPIVAR("DFN")=$PIECE(EXCPT,"^",1)
+4 SET MPIVAR("SSN")=$PIECE($GET(^DPT(+$PIECE(EXCPT,"^",1),0)),"^",9)
+5 SET MPIVAR("NM")=$PIECE($GET(^DPT(+$PIECE(EXCPT,"^",1),0)),"^",1)
+6 SET MPIVAR("DOB")=$PIECE($PIECE($GET(^DPT(+$PIECE(EXCPT,"^",1),0)),"^",3),".",1)
+7 DO VTQ^MPIFSAQ(.MPIVAR)
+8 DO PAUSE^VALM1
+9 SET VALMBCK="R"
+10 KILL MPIVAR
+11 QUIT
+12 ;
PDAT ;report to list CMOR, TF's & SUB's ;**333
+1 NEW DFN
+2 SET DFN=+$PIECE($GET(^DGCN(391.98,IEN,0)),"^",1)
+3 SET VALMBCK=""
+4 DO FULL^VALM1
+5 DO START^VAFCPDAT
+6 ;D PAUSE^VALM1
+7 SET VALMBCK="R"
+8 QUIT
+9 ;
CENTER(STRG) ;
+1 ;
+2 NEW LEN,FIL,FIL1
+3 SET LEN=80-$LENGTH(STRG)
+4 SET FIL=LEN/2
+5 SET $PIECE(FIL1," ",FIL)=""
+6 QUIT FIL1_STRG
+7 ;
PDRPRG ;Purge PDRs ;**477
+1 LOCK +^DGCN(391.98,"VAFC PDR PURGE"):0
IF '$TEST
WRITE $CHAR(7),!!,"The Purge Patient Data Reviews process is currently running."
QUIT
+2 LOCK -^DGCN(391.98,"VAFC PDR PURGE")
+3 NEW TDATE,MAXDT,PDATE,X1,X2,X,Y
+4 SET NDATE=""
+5 DO NOW^%DTC
SET TDATE=X
+6 SET X1=TDATE
SET X2=-30
DO C^%DTC
+7 SET (Y,MAXDT)=X
DO DD^%DT
SET PDATE=Y
+8 SET DIR("?")="Enter a date at least 30 days in the past."
+9 SET DIR("A")="Purge all Patient Data Reviews prior to "
+10 SET DIR("B")=PDATE
SET DIR(0)="DAO^:"_MAXDT_":EPX"
DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+11 SET NDATE=Y
+12 SET DIR(0)="YA"
SET DIR("B")="NO"
+13 SET DIR("A")="Are you sure you want to purge Patient Data Reviews? "
DO ^DIR
KILL DIR
if $DATA(DIRUT)
QUIT
+14 if Y=0
QUIT
+15 ;
+16 NEW ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,ZTREQ
+17 SET ZTRTN="QPRG^VAFCEHLM"
SET ZTDESC="PURGE PATIENT DATA REVIEWS OVER 30 DAYS OLD OR X DAYS OLD AS SPECIFIED BY USER."
+18 DO NOW^%DTC
+19 SET ZTIO=""
SET ZTDTH=%
+20 IF $DATA(DUZ)
SET ZTSAVE("DUZ")=DUZ
SET ZTSAVE("NDATE")=NDATE
+21 DO ^%ZTLOAD
+22 WRITE !!?15,"Patient Data Review Purge Queued, Task #"_ZTSK
+23 DO HOME^%ZIS
KILL IO("Q")
+24 QUIT
QPRG ;
+1 IF $DATA(ZTQUEUED)
SET ZTREQ="@"
+2 LOCK +^DGCN(391.98,"VAFC PDR PURGE"):0
IF '$TEST
QUIT
+3 NEW PDR,EVTDT,ERR
SET PDR=0
SET EVTDT=""
+4 FOR
SET EVTDT=$ORDER(^DGCN(391.98,"EVT",EVTDT))
if EVTDT>NDATE
QUIT
Begin DoDot:1
+5 FOR
SET PDR=$ORDER(^DGCN(391.98,"EVT",EVTDT,PDR))
if 'PDR
QUIT
Begin DoDot:2
+6 SET ERR=$$DELEXCPT^VAFCEHU1(PDR)
End DoDot:2
End DoDot:1
+7 LOCK -^DGCN(391.98,"VAFC PDR PURGE")
+8 KILL NDATE
+9 QUIT
