source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VAFHADT5.m@ 634

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

initial load of WorldVistAEHR
File size: 5.4 KB
Line 
1VAFHADT5 ;ALB/RJS - HL7 ADT BREAKOUT OF VAFHADT1 - APRIL 13,1995
2 ;;5.3;Registration;**91**;Jun 06, 1996
3 ;
4 ;This routine was broken out of routine VAFHADT1 and
5 ;contains numerous functions and procedures used by that routine
6 ;
713(DFN) ;
8 N NHCUADMT,NHCUNODE,MEDADMT,MEDNODE,NHCUCHK,NHCUPIVT,MEDPIVT
9 N TRANSFER,TRNSNODE,PSUEDO,PSUNODE
10 S NHCUADMT=$O(VAFH(1,0))
11 S NHCUNODE=VAFH(1,NHCUADMT,"A")
12 S MEDADMT=$O(VAFH(1,NHCUADMT))
13 S MEDNODE=VAFH(1,MEDADMT,"A")
14 S NHCUCHK=$$PIVCHK^VAFHPIVT(DFN,$P(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
15 S NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$P(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
16 S MEDPIVT=$$PIVNW^VAFHPIVT(DFN,$P(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
17 I NHCUCHK'>0 D G MEDICAL
18 . K HISTORY
19 . D BLDHIST^VAFHADT3(DFN,NHCUADMT,"HISTORY")
20 . D:$D(VATRACE) HISTORY^VAFHADT4
21 . D ENTIRE^VAFHADT4(+NHCUPIVT)
22 I NHCUCHK>0 D
23 . S TRANSFER=$O(VAFH(2,0))
24 . S TRNSNODE=VAFH(2,TRANSFER,"A")
25 . D BLDMSG^VAFHADT2(DFN,"A02",$P(TRNSNODE,"^",1),"05",TRANSFER,+NHCUPIVT)
26 . S PSUEDO=$O(VAFH(3,0))
27 . S PSUNODE=VAFH(3,PSUEDO,"A")
28 . D BLDMSG^VAFHADT2(DFN,"A03",$P(PSUNODE,"^",1),"05",PSUEDO,+NHCUPIVT)
29MEDICAL ;
30 D BLDMSG^VAFHADT2(DFN,"A01",$P(MEDNODE,"^",1),"05",MEDADMT,+MEDPIVT)
31 Q
32 ;
3314(DFN) ;
34 N NHCUADMT,NHCUNODE,NHCUPIVT,NHCUCHK,NHCUTRAN,TRANNODE,NHCUDIS,DISNODE
35 S NHCUADMT=$O(VAFH(1,0))
36 S NHCUNODE=VAFH(1,NHCUADMT,"A")
37 S NHCUCHK=$$PIVCHK^VAFHPIVT(DFN,$P(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
38 S NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$P(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
39 I +NHCUCHK'>0 D Q
40 . K HISTORY
41 . D BLDHIST^VAFHADT3(DFN,NHCUADMT,"HISTORY")
42 . D:$D(VATRACE) HISTORY^VAFHADT4
43 . D ENTIRE^VAFHADT4(+NHCUPIVT)
44 S NHCUDIS=$O(VAFH(3,0))
45 S DISNODE=VAFH(3,NHCUDIS,"P")
46 D BLDMSG^VAFHADT2(DFN,"A13",$P(DISNODE,"^",1),"05",NHCUDIS,+NHCUPIVT)
47 S NHCUTRAN=$O(VAFH(2,0))
48 S TRANNODE=VAFH(2,NHCUTRAN,"A")
49 D BLDMSG^VAFHADT2(DFN,"A02",$P(TRANNODE,"^",1),"05",NHCUTRAN,+NHCUPIVT)
50 Q
51 ;
5241(DFN) ;
53 N NHCUADMT,NHCUNODE,NHCUPIVT,NHCUCHK,MEDADMT,MEDNODE,MEDPIVT,MEDCHK,NHCUPREV
54 S NHCUADMT=$O(VAFH(1,0))
55 S NHCUNODE=VAFH(1,NHCUADMT,"A")
56 S NHCUPREV=VAFH(1,NHCUADMT,"P")
57 S MEDADMT=$O(VAFH(1,NHCUADMT))
58 S MEDNODE=VAFH(1,MEDADMT,"A")
59 S NHCUCHK=$$PIVCHK^VAFHPIVT(DFN,$P(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
60 S NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$P(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
61 S MEDCHK=$$PIVCHK^VAFHPIVT(DFN,$P(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
62 S MEDPIVT=$$PIVNW^VAFHPIVT(DFN,$P(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
63 I +MEDCHK>0 D BLDMSG^VAFHADT2(DFN,"A03",$P(MEDNODE,"^",1),"05",MEDADMT,+MEDPIVT)
64 I +MEDCHK'>0 D
65 . K HISTORY
66 . D BLDHIST^VAFHADT3(DFN,MEDADMT,"HISTORY")
67 . D:$D(VATRACE) HISTORY^VAFHADT4
68 . D ENTIRE^VAFHADT4(+MEDPIVT)
69 I +NHCUCHK>0 D
70 . S NHCUDSDT=$P(VAFH(3,$P(NHCUPREV,"^",17),"P"),"^",1)
71 . D BLDMSG^VAFHADT2(DFN,"A13",NHCUDSDT,"05",NHCUADMT,+NHCUPIVT)
72 . D BLDMSG^VAFHADT2(DFN,"A02",$P(DGPMA,"^",1),"05",NHCUADMT,+NHCUPIVT)
73 I +NHCUCHK'>0 D
74 . K HISTORY
75 . D BLDHIST^VAFHADT3(DFN,NHCUADMT,"HISTORY")
76 . D:$D(VATRACE) HISTORY^VAFHADT4
77 . D ENTIRE^VAFHADT4(+NHCUPIVT)
78 Q
7943(DFN) ;
80 N NHCUADMT,NHCUNODE,NHCUPIVT,NHCUCHK,NHCUTRAN,TRANNODE,NHCUDIS,DISNODE
81 S NHCUADMT=$O(VAFH(1,0))
82 S NHCUNODE=VAFH(1,NHCUADMT,"A")
83 S NHCUCHK=$$PIVCHK^VAFHPIVT(DFN,$P(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
84 S NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$P(NHCUNODE,"^",1),1,NHCUADMT_";DGPM(")
85 I +NHCUCHK'>0 D Q
86 . K HISTORY
87 . D BLDHIST^VAFHADT3(DFN,NHCUADMT,"HISTORY")
88 . D:$D(VATRACE) HISTORY^VAFHADT4
89 . D ENTIRE^VAFHADT4(+NHCUPIVT)
90 S NHCUTRAN=$O(VAFH(2,0))
91 S TRANNODE=VAFH(2,NHCUTRAN,"A")
92 D BLDMSG^VAFHADT2(DFN,"A02",$P(TRANNODE,"^",1),"05",NHCUTRAN,+NHCUPIVT)
93 S NHCUDIS=$O(VAFH(3,0))
94 S DISNODE=VAFH(3,NHCUDIS,"A")
95 D BLDMSG^VAFHADT2(DFN,"A03",$P(DISNODE,"^",1),"05",NHCUDIS,+NHCUPIVT)
96 Q
9744(DFN) ;
98 N NHCUADMT,NHCUNODE,MEDADMT,MEDNODE,NHCUCHK,NHCUPIVT,MEDPIVT
99 N TRANSFER,TRANNODE
100 S MEDADMT=$O(VAFH(1,0))
101 S MEDNODE=VAFH(1,MEDADMT,"A")
102 S TRANSFER=$O(VAFH(2,0))
103 S TRANNODE=VAFH(2,TRANSFER,"A")
104 S NHCUADMT=$P(TRANNODE,"^",14)
105 S NHCUCHK=$$PIVCHK^VAFHPIVT(DFN,$$ADMDATE^VAFHADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
106 S NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$$ADMDATE^VAFHADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
107 S MEDPIVT=$$PIVNW^VAFHPIVT(DFN,$P(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
108 I +NHCUCHK'>0 D
109 . K HISTORY
110 . D BLDHIST^VAFHADT3(DFN,NHCUADMT,"HISTORY")
111 . D:$D(VATRACE) HISTORY^VAFHADT4
112 . D ENTIRE^VAFHADT4(+NHCUPIVT)
113 I +NHCUCHK>0 D BLDMSG^VAFHADT2(DFN,"A02",$P(TRANNODE,"^",1),"05",TRANSFER,+NHCUPIVT)
114 D BLDMSG^VAFHADT2(DFN,"A01",$P(MEDNODE,"^",1),"05",MEDADMT,+MEDPIVT)
115 Q
116 ;
11746(DFN) ;
118 N NHCUADMT,NHCUNODE,NHCUPIVT,NHCUCHK,NHCUTRAN
119 N MEDADMT,MEDNODE,MEDDIS,MEDPIVT,DISNODE
120 S NHCUTRAN=$O(VAFH(2,0))
121 S NHCUNODE=VAFH(2,NHCUTRAN,"A")
122 S NHCUADMT=$P(VAFH(2,NHCUTRAN,"A"),"^",14)
123 S NHCUCHK=$$PIVCHK^VAFHPIVT(DFN,$$ADMDATE^VAFHADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
124 S NHCUPIVT=$$PIVNW^VAFHPIVT(DFN,$$ADMDATE^VAFHADT4(NHCUADMT),1,NHCUADMT_";DGPM(")
125 I +NHCUCHK'>0 D
126 . K HISTORY
127 . D BLDHIST^VAFHADT3(DFN,NHCUADMT,"HISTORY")
128 . D:$D(VATRACE) HISTORY^VAFHADT4
129 . D ENTIRE^VAFHADT4(+NHCUPIVT)
130 I +NHCUCHK>0 D BLDMSG^VAFHADT2(DFN,"A02",$P(NHCUNODE,"^",1),"05",NHCUTRAN,+NHCUPIVT)
131 S MEDADMT=$O(VAFH(1,0))
132 S MEDNODE=VAFH(1,MEDADMT,"A")
133 S MEDCHK=$$PIVCHK^VAFHPIVT(DFN,$P(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
134 S MEDDIS=$O(VAFH(3,0))
135 S DISNODE=VAFH(3,MEDDIS,"A")
136 S MEDPIVT=$$PIVNW^VAFHPIVT(DFN,$P(MEDNODE,"^",1),1,MEDADMT_";DGPM(")
137 I +MEDCHK>0 D BLDMSG^VAFHADT2(DFN,"A03",$P(DISNODE,"^",1),"05",MEDDIS,+MEDPIVT)
138 I +MEDCHK'>0 D
139 . K HISTORY
140 . D BLDHIST^VAFHADT3(DFN,MEDADMT,"HISTORY")
141 . D:$D(VATRACE) HISTORY^VAFHADT4
142 . D ENTIRE^VAFHADT4(+MEDPIVT)
143 Q
Note: See TracBrowser for help on using the repository browser.