Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: VAFCEHLM

VAFCEHLM.m

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