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

VPRPCMM.m

Go to the documentation of this file.
  1. VPRPCMM ;SLC/MKB/BLJ -- PCMM Utilities ;2/20/20 14:58
  1. ;;1.0;VIRTUAL PATIENT RECORD;**24,28**;Sep 01, 2011;Build 6
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; External References DBIA#
  1. ; ------------------- -----
  1. ; SCMC PATIENT TEAM CHANGES 7012
  1. ; SCMC PATIENT TEAM POSITION 7013
  1. ; ^SCTM(404.52 7174
  1. ; %DTC
  1. ; %ZTLOAD 10063
  1. ; DIQ 2056
  1. ; SCAPMC 1916
  1. ; SDUTL3 1252
  1. ;
  1. PCP ; -- get DLIST(#)=ien^role of PCP, team members
  1. ; Expects DFN, VPRTEAM = ien^name of PCTeam
  1. N PCP,ALL S PCP=$$OUTPTPR^SDUTL3(DFN)
  1. S:PCP>0 DLIST(1)=+PCP_"^PRIMARY CARE PROVIDER"
  1. S ALL=$$PRPT^SCAPMC(DFN,,,,,,"VPRPTP") ;all prov's assigned to pt
  1. MBRS ; -- enter here for just team members [expects VPRTEAM, VPRPTP]
  1. N VPRTM,VPRN,PRV,ROLE
  1. Q:'$G(VPRTEAM) ;set by *TeamName property
  1. Q:'$$PRTM^SCAPMC(+$G(VPRTEAM),,,,"VPRTM") ;team members
  1. S VPRN=+$O(DLIST("A"),-1)
  1. S PRV=0 F S PRV=$O(VPRTM("SCPR",PRV)) Q:PRV<1 I PRV'=+$G(PCP) D
  1. . S ROLE=+$O(VPRTM("SCPR",PRV,0))
  1. . Q:'$D(VPRPTP("SCPR",PRV,ROLE)) ;not assigned to pt
  1. . S VPRN=VPRN+1,DLIST(VPRN)=PRV_U_$$GET1^DIQ(404.57,ROLE,.01)
  1. . ; provider #200 ien ^ position name
  1. Q
  1. ;
  1. MHTEAM(DFN) ; -- returns ien^name of MH Team, or ""
  1. N X,Y,VPRP,VPRTM
  1. S VPRP(4)="",X=$$TMPT^SCAPMC(DFN,,"VPRP","VPRTM"),Y=""
  1. I X S Y=$G(VPRTM(1))
  1. Q Y
  1. ;
  1. PTEVT ; -- SCMC PATIENT TEAM CHANGES protocol listener
  1. ;I '$G(SCPCTM) Q ;not pc change
  1. N DFN S DFN=$S($G(SCPTTMAF):+SCPTTMAF,1:+$G(SCPTTMB4)) Q:'DFN
  1. D QUE^VPRHS(DFN) ;POST^VPRHS(DFN,"Patient",DFN_";2")
  1. Q
  1. ;
  1. PTPEVT ; -- SCMC PATIENT TEAM POSITION CHANGES protocol listener
  1. ;I '$G(SCPCTP) Q ;not pc change
  1. N TM,DFN
  1. S TM=$S($G(SCPTTPAF):+SCPTTPAF,1:+$G(SCPTTPB4)) Q:'TM
  1. S DFN=+$$GET1^DIQ(404.42,TM_",",.01,"I")
  1. D QUE^VPRHS(DFN) ;POST^VPRHS(DFN,"Patient",DFN_";2")
  1. Q
  1. ;
  1. PTPCEVT ; -- PROVIDER TEAM POSITION change tasked job.
  1. N U S U="^"
  1. N DFN,DATE,EFFDATE,POSITION,%
  1. S EFFDATE=9999999
  1. D NOW^%DTC S DATE=%-1 ; Get the last 24 hrs of changes.
  1. F S EFFDATE=$O(^SCTM(404.52,"ADP",EFFDATE),-1) Q:EFFDATE<DATE D
  1. .S POSITION=""
  1. .F S POSITION=$O(^SCTM(404.52,"ADP",EFFDATE,POSITION)) Q:'POSITION D
  1. ..K ^TMP("SC TMP LIST",$J)
  1. ..Q:'$$PTTP^SCAPMC(POSITION)
  1. ..S DFN=0
  1. ..F S DFN=$O(^TMP("SC TMP LIST",$J,"SCPTA",DFN)) Q:+DFN<1 D QUE^VPRHS(DFN)
  1. K ^TMP("SC TMP LIST",$J)
  1. Q