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

VPRP15.m

Go to the documentation of this file. 
  1. VPRP15 ;SLC/MKB -- SDA utilities for patch 15 ;11/8/18  14:11
  1.  ;;1.0;VIRTUAL PATIENT RECORD;**15**;Sep 01, 2011;Build 9
  1.  ;;Per VHA Directive 6402, this routine should not be modified.
  1.  ;
  1.  ; External References          DBIA#
  1.  ; -------------------          -----
  1.  ; XUSAP                         4677
  1.  ;
  1.  ;
  1. POST ; -- postinit tasks
  1.  D PRXY,TASK
  1.  Q
  1.  ;
  1. PRXY ; -- create proxy user
  1.  I '$O(^VA(200,"B","VPRVDIF,APPLICATION PROXY",0)) D
  1.  . N X S X=$$CREATE^XUSAP("VPRVDIF,APPLICATION PROXY","")
  1.  Q
  1.  ;
  1. TASK ; -- task job to clean up ^VPR
  1.  I '$D(^VPR("AVPR")),'$D(^VPR("ANEW")) D MES^XPDUTL("No task queued; no entries in update lists.") Q
  1.  N ZTRTN,ZTDTH,ZTDESC,ZTIO,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC,ZTSK
  1.  S ZTRTN="LIST^VPRP15",ZTDTH=$$NOW^XLFDT,ZTIO=""
  1.  S ZTDESC="Remove duplicate nodes from VPR update lists"
  1.  D ^%ZTLOAD I '$G(ZTSK) D MES^XPDUTL("Unable to queue clean up task.") Q
  1.  D MES^XPDUTL("Task #"_ZTSK_" was queued to clean up ^VPR")
  1.  Q
  1.  ;
  1. LIST ; -- clean up ^VPR update lists
  1.  N SEQ,DFN,TYPE,ID,X,XREF
  1.  ;
  1.  ; ANEW = patients to subscribe
  1.  S SEQ=0 F  S SEQ=+$O(^VPR("ANEW",SEQ)) Q:SEQ<1  S DFN=+$O(^(SEQ,0)) D
  1.  . S X=$G(^VPR(1,2,DFN,"ANEW"))
  1.  . I X'>0 S ^VPR(1,2,DFN,"ANEW")=SEQ Q  ;create
  1.  . I X,X'=SEQ K ^VPR("ANEW",SEQ,DFN) Q  ;duplicate, remove
  1.  . I X,X=SEQ Q                          ;ok (if re-run)
  1.  ;
  1.  ; AVPR = data updates
  1.  S SEQ=0 F  S SEQ=+$O(^VPR("AVPR",SEQ)) Q:SEQ<1  S DFN=+$O(^(SEQ,0)),XREF=$G(^(DFN)) D
  1.  . S TYPE=$P(XREF,U,2) Q:TYPE=""
  1.  . S ID=$P(XREF,U,3) S:ID="" ID="*"
  1.  . ;
  1.  . ; look for bad nodes
  1.  . I TYPE="OtherOrder",ID,$$BADORD K ^VPR(1,2,DFN,"AVPR",TYPE,ID),^VPR("AVPR",SEQ,DFN) Q
  1.  . I TYPE="Referral",ID,$$BADREF K ^VPR(1,2,DFN,"AVPR",TYPE,ID),^VPR("AVPR",SEQ,DFN) Q
  1.  . ;
  1.  . ; create patient node, or Q if exists (re-run)
  1.  . S X=$G(^VPR(1,2,DFN,"AVPR",TYPE,ID))
  1.  . I X'>0 S ^VPR(1,2,DFN,"AVPR",TYPE,ID)=SEQ_U_$P(XREF,U,4,5) Q
  1.  . I X,+X=SEQ Q
  1.  . ;
  1.  . ; duplicate - keep first SEQ (+X) but update action^visit to latest
  1.  . S ^VPR(1,2,DFN,"AVPR",TYPE,ID)=+X_U_$P(XREF,U,4,5)
  1.  . S $P(^VPR("AVPR",+X,DFN),U,4,5)=$P(XREF,U,4,5)
  1.  . K ^VPR("AVPR",SEQ,DFN)
  1.  Q
  1.  ;
  1. BADORD() ; -- return 1 or 0, if not truly an Other order
  1.  N X,Y,PKG
  1.  S X=+$P($G(^OR(100,+$G(ID),0)),U,14),PKG=$$GET1^DIQ(9.4,X,1)
  1.  S Y=$S($E(PKG,1,2)="LR":1,$E(PKG,1,2)="PS":1,$E(PKG,1,2)="RA":1,1:0)
  1.  Q Y
  1.  ;
  1. BADREF() ; -- return 1 or 0, if bad Referral reference
  1.  I $P(ID,";",2)=100 Q 1
  1.  I '$D(^GMR(123,+ID,0)) Q 1
  1.  I $P(^GMR(123,+ID,0),U,2)'=DFN Q 1
  1.  Q 0