source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGPMVPU.m@ 1093

Last change on this file since 1093 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.3 KB
Line 
1DGPMVPU ;ALB/CAW - Update Provider(s) from OE/RR ;4/19/95
2 ;;5.3;Registration;**57**;Aug 13, 1993
3 ;
4EN ; Queue provider update to avoid problems with recursive calls
5 S ZTSAVE("XQORMSG(")="",ZTIO="",ZTDTH=$$NOW^XLFDT(),ZTRTN="DQ^DGPMVPU"
6 S ZTDESC="Update provider based on OR pre-admit order"
7 D ^%ZTLOAD
8 K ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
9 Q
10 ;
11DQ ; Find last movement from event date
12 D INIT G:$G(DGQUIT) ENQ
13 D FMVMT ;Find last treating specialty movement
14 I '$$INPTCHK(DFN) G ENQ ;Check to see if patient is current inpatient
15 D COMPARE G:'$G(DGGO) ENQ ;Check to see if a provider change
16 D CRMVMT ;Create new entry and update provider
17 D EVT ;Set up event driver variables
18 S DGQUIET=1 D ^DGPMEVT ;Call DGPM event driver
19ENQ K DGEVT,DFN,DGPPROV,DGAPROV,DGLSTM,DGMVMT,DGMVT,DGPMT,DGPMPC,DGPMCA
20 K DGPMDA,DGPMP,DGQUIET,DGPMN,DGPMA,DGQUIT,DGGO,Y,^UTILITY("DGPM",$J)
21 Q
22 ;
23INIT ; Init variables
24 ; Input - XQORMSG variables from OE/RR
25 ; Output - DGEVT = The event type-needs to A08 for provider update
26 ; DFN = Patient IFN (from XQORMSG variables)
27 ; DGPPROV = Primary Provider (from XQORMSG variables)
28 ; DGAPROV = Attending Provider (from XQORMSG variables)
29 ; DGLSTM = Date/Time of event (from XQORMSG variables)
30 ;
31 S DGEVT=$P(XQORMSG(2),"|",2) I DGEVT'="A08" S DGQUIT=1 G INITQ
32 S DFN=$P(XQORMSG(3),"|",4)
33 I $G(^DPT(DFN,0))']"" S DGQUIT=1 G INITQ
34 S DGLSTM=$P(XQORMSG(2),"|",3) I 'DGLSTM S DGQUIT=1 G INITQ
35 S DGPPROV=$P($P(XQORMSG(5),"|",2),U),DGAPROV=$P($P(XQORMSG(4),"|",8),U)
36 I 'DGPPROV&('DGAPROV) S DGQUIT=1
37INITQ Q
38 ;
39INPTCHK(DFN) ; Check to see if patient is a current inpatient
40 ; Input - DFN = Patient IFN
41 ; Output - 0 = Not a current inpatient
42 ; number = internal file number of the admission movement
43 ;
44 N VAIN,VAINDT,VAERR
45 D NOW^%DTC S VAINDT=%
46 D ADM^VADPT2
47 Q +VADMVT
48 ;
49FMVMT ; Find the last movement
50 ; Input - DGLSTM = The date/time passes in from OE/RR
51 ; Output - DGMVMT = The 0th node of the last treating specialty
52 ; DGMVT = The IFN of the last treating specialty
53 ;
54 N DGLST
55 S DGLST=9999999.9999999-DGLSTM
56 S DGLST=$O(^DGPM("ATID6",DFN,DGLST))
57 S DGMVT=$O(^DGPM("ATID6",DFN,+DGLST,""))
58 S DGMVMT=$G(^DGPM(+DGMVT,0))
59FMVMTQ Q
60 ;
61COMPARE ; Check to see if provider is different than what is on file
62 ; Input - DGMVMT = 0th node of last treating specialty
63 ; DGPPROV = Primary Provider IFN
64 ; DGAPROV = Attending Provider IFN
65 ; Output - DGGO = Set if Primary/Attending is changing
66 ;
67 I $P(DGMVMT,U,8)'=DGPPROV S DGGO=1
68 I $P(DGMVMT,U,19)'=DGAPROV S DGGO=1
69 Q
70 ;
71CRMVMT ; Create new movement for provider change
72 ; Input - DFN - Patient IFN
73 ; DGMVMT - 0th node of last treating specialty
74 ;
75 N DA,Y,%,X,DIC,DIK,DGPMY,DGPM0ND
76 K ^UTILITY("DGPM",$J)
77 D NOW^%DTC S DGPMY=%
78 S DGPM0ND=DGPMY_"^"_6_"^"_DFN_"^^^^^"_DGPPROV_"^^^^^^"_$P(DGMVMT,U,14)_"^^^^^"_DGAPROV
79 S DGPMT=6,DGPMPC="",DGPMCA=$P(DGMVMT,U,14)
80 S DGPM0ND=$$PRODAT^DGPMV3(DGPM0ND)
81 D NEW^DGPMV301 S DGMVT=+Y
82 Q
83 ;
84EVT ; Create variables for DGPM event driver
85 ; Input - DGMVT - IFN of ^DGPM
86 ; Output - DGPMP - 0th node of prior update
87 ; DGPMA - 0th node of after update
88 ; Corresponding before/after ^UTILITY( global
89 ;
90 S (DGPMDA,Y)=DGMVT
91 S (DGPMP,^UTILITY("DGPM",$J,6,+Y,"P"))=""
92 S DGPMN=1 D PRIOR^DGPMV36
93 S (DGPMA,^UTILITY("DGPM",$J,6,+Y,"A"))=$G(^DGPM(+Y,0))
94 D AFTER^DGPMV36
95 Q
Note: See TracBrowser for help on using the repository browser.