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