source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SDOEOE.m@ 636

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

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1SDOEOE ;ALB/MJK - ACRP APIs For An Encounter ;8/12/96
2 ;;5.3;Scheduling;**131,132**;Aug 13, 1993
3 ;
4OE0(SDOE) ; -- get only supported 0th node fields
5 Q $$OE0^SDOEQ(.SDOE) ; -- in SDOEQ for SCAN speed reasons
6 ;
7 ;
8GETOE(SDOE,SDERR) ; -- SDOE GET ZERO NODE
9 ; API ID: 98
10 ;
11 ;
12 Q $S($$VALOE(.SDOE,$G(SDERR)):$$OE0^SDOEQ(.SDOE),1:"")
13 ;
14 ;
15GETGEN(SDOE,SDAT,SDERR) ; -- SDOE GET GENERAL DATA
16 ; API ID: 76
17 ;
18 ;
19GETGENG ; -- goto entry point
20 ; -- do validation checks
21 IF '$$VALOE(.SDOE,$G(SDERR)) G GETGENQ
22 ;
23 S @SDAT=SDOE
24 S @SDAT@(0)=$$OE0^SDOEQ(.SDOE)
25GETGENQ Q
26 ;
27 ;
28PARSE(SDATA,SDFMT,SDY,SDERR) ; -- SDOE PARSE GENERAL DATA
29 ; API ID: 78
30 ;
31 ;
32PARSEG ; -- goto entry point
33 ; -- do validation checks
34 ; -- invalid format check
35 IF '$$VALFMT(SDFMT,$G(SDERR)) G PARSEQ
36 ;
37 ; -- no data check
38 IF $G(SDATA(0))="" D G PARSEQ
39 . D BLD^SDQVAL(4096800.024,"","",$G(SDERR))
40 ;
41 IF SDFMT="EXTERNAL" D G PARSEQ
42 . N SDX S SDX=$G(SDATA(0))
43 . S @SDY@(.01)=$$FMTE^XLFDT($P(SDX,"^",1))
44 . S @SDY@(.02)=$P($G(^DPT(+$P(SDX,"^",2),0)),"^")
45 . S @SDY@(.03)=$P($G(^DIC(40.7,+$P(SDX,"^",3),0)),"^")
46 . S @SDY@(.04)=$P($G(^SC(+$P(SDX,"^",4),0)),"^")
47 . S @SDY@(.05)=$$FMTE^XLFDT($P($G(^AUPNVSIT(+$P(SDX,"^",5),0)),"^"))
48 . S @SDY@(.06)=$$FMTE^XLFDT($P($G(^SCE(+$P(SDX,"^",6),0)),"^"))
49 . S @SDY@(.07)=$$FMTE^XLFDT($P(SDX,"^",7))
50 . ;
51 . S X=$P(SDX,"^",8)
52 . S @SDY@(.08)=$S(X=1:"APPOINTMENT",X=2:"STOP CODE ADDITION",X=3:"DISPOSITION",X=4:"CREDIT STOP CODE",1:"")
53 . ;
54 . ; S @SDY@(.09)=$P(SDX,"^",9) ; -- extended reference not supported
55 . S @SDY@(.1)=$P($G(^SD(409.1,+$P(SDX,"^",10),0)),"^")
56 . S @SDY@(.11)=$P($G(^DG(40.8,+$P(SDX,"^",11),0)),"^")
57 . S @SDY@(.12)=$P($G(^SD(409.63,+$P(SDX,"^",12),0)),"^")
58 . S @SDY@(.13)=$P($G(^DIC(8,+$P(SDX,"^",13),0)),"^")
59 ;
60 ;
61 IF SDFMT="INTERNAL" D G PARSEQ
62 . N SDX S SDX=$G(SDATA(0))
63 . S @SDY@(.01)=$P(SDX,"^",1)
64 . S @SDY@(.02)=$P(SDX,"^",2)
65 . S @SDY@(.03)=$P(SDX,"^",3)
66 . S @SDY@(.04)=$P(SDX,"^",4)
67 . S @SDY@(.05)=$P(SDX,"^",5)
68 . S @SDY@(.06)=$P(SDX,"^",6)
69 . S @SDY@(.07)=$P(SDX,"^",7)
70 . S @SDY@(.08)=$P(SDX,"^",8)
71 . ;S @SDY@(.09)=$P(SDX,"^",9) ; -- extended reference not supported
72 . S @SDY@(.1)=$P(SDX,"^",10)
73 . S @SDY@(.11)=$P(SDX,"^",11)
74 . S @SDY@(.12)=$P(SDX,"^",12)
75 . S @SDY@(.13)=$P(SDX,"^",13)
76 ;
77PARSEQ Q
78 ;
79 ;
80EXAE(DFN,SDBEG,SDEND,SDFLAGS,SDERR) ; -- SDOE FIND FIRST STANDALONE
81 ; API ID: 72
82 ;
83 N SDOE,SDE,X,SDT,SDQUIT
84 S SDOE=""
85 ;
86 ; -- do validation checks
87 IF '$$PAT^SDQVAL(.DFN,$G(SDERR)) G EXAEQ
88 IF '$$RANGE^SDQVAL(.SDBEG,.SDEND,$G(SDERR)) G EXAEQ
89 ;
90 S SDQUIT=0
91 S SDT=SDBEG-.000001,SDE=SDEND+$S($P(SDEND,".",2)="":.24,1:"")
92 F S SDT=$O(^SCE("ADFN",DFN,SDT)) Q:'SDT!(SDT>SDE) D Q:SDQUIT
93 . S SDOE=0 F S SDOE=$O(^SCE("ADFN",DFN,SDT,SDOE)) Q:'SDOE D Q:SDQUIT
94 . . S X=$$OE0^SDOEQ(.SDOE)
95 . . IF $G(SDFLAGS)["C",'$P(X,"^",7) Q ; quit if not "C"ompleted
96 . . IF $P(X,"^",6) Q ; Parents only
97 . . IF $P(X,"^",8)'=2 Q ; Stop code addition only
98 . . S SDQUIT=1 ; Quit after one hit
99 ;
100EXAEQ Q SDOE
101 ;
102 ;
103GETLAST(DFN,SDBEG,SDFLAGS,SDERR) ; -- SDOE FIND LAST STANDALONE
104 ; API ID: 75
105 ;
106 N SDOE,SDE,X,SDT,SDQUIT,SDEND
107 S SDOE="",SDEND=9999999
108 ;
109 ; -- do validation checks
110 IF '$$PAT^SDQVAL(.DFN,$G(SDERR)) G GETLASTQ
111 IF '$$RANGE^SDQVAL(.SDBEG,.SDEND,$G(SDERR)) G GETLASTQ
112 ;
113 S SDQUIT=0
114 S SDT=SDEND
115 F S SDT=$O(^SCE("ADFN",DFN,SDT),-1) Q:'SDT!(SDT<SDBEG) D Q:SDQUIT
116 . S SDOE="" F S SDOE=$O(^SCE("ADFN",DFN,SDT,SDOE),-1) Q:'SDOE D Q:SDQUIT
117 . . S X=$$OE0^SDOEQ(.SDOE)
118 . . IF $G(SDFLAGS)["C",'$P(X,"^",7) Q ; quit if not "C"ompleted
119 . . IF $P(X,"^",6) Q ; Parents only
120 . . IF $P(X,"^",8)'=2 Q ; Stop code addition only
121 . . S SDQUIT=1 ; Quit after one hit
122 ;
123GETLASTQ Q SDOE
124 ;
125 ;
126EXOE(DFN,SDBEG,SDEND,SDFLAGS,SDERR) ; -- SDOE FIND FIRST ENCOUNTER
127 ; API ID: 74
128 ;
129 N SDOE,SDE,X,SDT,SDQUIT
130 S SDOE=""
131 ;
132 ; -- do validation checks
133 IF '$$PAT^SDQVAL(.DFN,$G(SDERR)) G EXOEQ
134 IF '$$RANGE^SDQVAL(.SDBEG,.SDEND,$G(SDERR)) G EXOEQ
135 ;
136 S SDQUIT=0
137 S SDT=SDBEG-.000001,SDE=SDEND+$S($P(SDEND,".",2)="":.24,1:"")
138 F S SDT=$O(^SCE("ADFN",DFN,SDT)) Q:'SDT!(SDT>SDE) D Q:SDQUIT
139 . S SDOE=0 F S SDOE=$O(^SCE("ADFN",DFN,SDT,SDOE)) Q:'SDOE D Q:SDQUIT
140 . . S X=$$OE0^SDOEQ(.SDOE)
141 . . IF $G(SDFLAGS)["C",'$P(X,"^",7) Q ; quit if not "C"ompleted
142 . . S SDQUIT=1 ; Quit after one hit
143 ;
144EXOEQ Q SDOE
145 ;
146 ;
147VALOE(SDOE,SDERR) ; -- validate sdoe input
148 ;
149 ; -- do checks
150 IF SDOE,$D(^SCE(SDOE,0)) Q 1
151 ;
152 ; -- build error msg
153 N SDIN,SDOUT
154 S SDIN("ID")=SDOE
155 S SDOUT("ID")=SDOE
156 D BLD^SDQVAL(4096800.001,.SDIN,.SDOUT,$G(SDERR))
157 Q 0
158 ;
159 ;
160VALFMT(SDFMT,SDERR) ; -- validate return format
161 ;
162 ; -- do checks
163 IF SDFMT="EXTERNAL"!(SDFMT="INTERNAL") Q 1
164 ;
165 ; -- build error msg
166 N SDIN,SDOUT
167 S SDIN("FORMAT")=SDFMT
168 S SDOUT("FORMAT")=SDFMT
169 D BLD^SDQVAL(4096800.023,.SDIN,.SDOUT,$G(SDERR))
170 Q 0
171 ;
Note: See TracBrowser for help on using the repository browser.