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

DGPMVPU.m

Go to the documentation of this file.
  1. DGPMVPU ;ALB/CAW - Update Provider(s) from OE/RR ;4/19/95
  1. ;;5.3;Registration;**57,1015**;Aug 13, 1993;Build 21
  1. ;
  1. EN ; Queue provider update to avoid problems with recursive calls
  1. S ZTSAVE("XQORMSG(")="",ZTIO="",ZTDTH=$$NOW^XLFDT(),ZTRTN="DQ^DGPMVPU"
  1. S ZTDESC="Update provider based on OR pre-admit order"
  1. D ^%ZTLOAD
  1. K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
  1. Q
  1. ;
  1. DQ ; Find last movement from event date
  1. D INIT G:$G(DGQUIT) ENQ
  1. D FMVMT ;Find last treating specialty movement
  1. I '$$INPTCHK(DFN) G ENQ ;Check to see if patient is current inpatient
  1. D COMPARE G:'$G(DGGO) ENQ ;Check to see if a provider change
  1. D CRMVMT ;Create new entry and update provider
  1. D EVT ;Set up event driver variables
  1. S DGQUIET=1 D ^DGPMEVT ;Call DGPM event driver
  1. ENQ K DGEVT,DFN,DGPPROV,DGAPROV,DGLSTM,DGMVMT,DGMVT,DGPMT,DGPMPC,DGPMCA
  1. K DGPMDA,DGPMP,DGQUIET,DGPMN,DGPMA,DGQUIT,DGGO,Y,^UTILITY("DGPM",$J)
  1. Q
  1. ;
  1. INIT ; Init variables
  1. ; Input - XQORMSG variables from OE/RR
  1. ; Output - DGEVT = The event type-needs to A08 for provider update
  1. ; DFN = Patient IFN (from XQORMSG variables)
  1. ; DGPPROV = Primary Provider (from XQORMSG variables)
  1. ; DGAPROV = Attending Provider (from XQORMSG variables)
  1. ; DGLSTM = Date/Time of event (from XQORMSG variables)
  1. ;
  1. S DGEVT=$P(XQORMSG(2),"|",2) I DGEVT'="A08" S DGQUIT=1 G INITQ
  1. S DFN=$P(XQORMSG(3),"|",4)
  1. I $G(^DPT(DFN,0))']"" S DGQUIT=1 G INITQ
  1. S DGLSTM=$P(XQORMSG(2),"|",3) I 'DGLSTM S DGQUIT=1 G INITQ
  1. S DGPPROV=$P($P(XQORMSG(5),"|",2),U),DGAPROV=$P($P(XQORMSG(4),"|",8),U)
  1. I 'DGPPROV&('DGAPROV) S DGQUIT=1
  1. INITQ Q
  1. ;
  1. INPTCHK(DFN) ; Check to see if patient is a current inpatient
  1. ; Input - DFN = Patient IFN
  1. ; Output - 0 = Not a current inpatient
  1. ; number = internal file number of the admission movement
  1. ;
  1. N VAIN,VAINDT,VAERR
  1. D NOW^%DTC S VAINDT=%
  1. D ADM^VADPT2
  1. Q +VADMVT
  1. ;
  1. FMVMT ; Find the last movement
  1. ; Input - DGLSTM = The date/time passes in from OE/RR
  1. ; Output - DGMVMT = The 0th node of the last treating specialty
  1. ; DGMVT = The IFN of the last treating specialty
  1. ;
  1. N DGLST
  1. S DGLST=9999999.9999999-DGLSTM
  1. S DGLST=$O(^DGPM("ATID6",DFN,DGLST))
  1. S DGMVT=$O(^DGPM("ATID6",DFN,+DGLST,""))
  1. S DGMVMT=$G(^DGPM(+DGMVT,0))
  1. FMVMTQ Q
  1. ;
  1. COMPARE ; Check to see if provider is different than what is on file
  1. ; Input - DGMVMT = 0th node of last treating specialty
  1. ; DGPPROV = Primary Provider IFN
  1. ; DGAPROV = Attending Provider IFN
  1. ; Output - DGGO = Set if Primary/Attending is changing
  1. ;
  1. I $P(DGMVMT,U,8)'=DGPPROV S DGGO=1
  1. I $P(DGMVMT,U,19)'=DGAPROV S DGGO=1
  1. Q
  1. ;
  1. CRMVMT ; Create new movement for provider change
  1. ; Input - DFN - Patient IFN
  1. ; DGMVMT - 0th node of last treating specialty
  1. ;
  1. N DA,Y,%,X,DIC,DIK,DGPMY,DGPM0ND
  1. K ^UTILITY("DGPM",$J)
  1. D NOW^%DTC S DGPMY=%
  1. S DGPM0ND=DGPMY_"^"_6_"^"_DFN_"^^^^^"_DGPPROV_"^^^^^^"_$P(DGMVMT,U,14)_"^^^^^"_DGAPROV
  1. S DGPMT=6,DGPMPC="",DGPMCA=$P(DGMVMT,U,14)
  1. S DGPM0ND=$$PRODAT^DGPMV3(DGPM0ND)
  1. D NEW^DGPMV301 S DGMVT=+Y
  1. Q
  1. ;
  1. EVT ; Create variables for DGPM event driver
  1. ; Input - DGMVT - IFN of ^DGPM
  1. ; Output - DGPMP - 0th node of prior update
  1. ; DGPMA - 0th node of after update
  1. ; Corresponding before/after ^UTILITY( global
  1. ;
  1. S (DGPMDA,Y)=DGMVT
  1. S (DGPMP,^UTILITY("DGPM",$J,6,+Y,"P"))=""
  1. S DGPMN=1 D PRIOR^DGPMV36
  1. S (DGPMA,^UTILITY("DGPM",$J,6,+Y,"A"))=$G(^DGPM(+Y,0))
  1. D AFTER^DGPMV36
  1. Q