- DGPMVPU ;ALB/CAW - Update Provider(s) from OE/RR ;4/19/95
- ;;5.3;Registration;**57,1015**;Aug 13, 1993;Build 21
- ;
- 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
- DGPMVPU ;ALB/CAW - Update Provider(s) from OE/RR ;4/19/95
- +1 ;;5.3;Registration;**57,1015**;Aug 13, 1993;Build 21
- +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