source: FOIAVistA/tag/r/SCHEDULING-SD-SC/SCDXUTL.m@ 1796

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

initial load of FOIAVistA 6/30/08 version

File size: 4.3 KB
Line 
1SCDXUTL ;ALB/JLU;Utility routine for ambcare project;4/26/96
2 ;;5.3;Scheduling;**44,78,132**;5/1/96
3 ;
4DATE(DATE) ;this entry point will accept a date and return whether the new or old Scheduling Visits file limitations are to be used.
5 ;INPUTS - a date in FM format to be compared to the ambcare start
6 ; date parameter,
7 ;OUTPUTS - 1 for using the new structure
8 ; 0 for using the old structure
9 ;
10 N PAR,ANS
11 S PAR=$P($G(^SD(404.91,1,"AMB")),U,2) ;get parameter date
12 I 'PAR S ANS=0 G QT
13 I DATE<PAR S ANS=0 G QT ;if date passed in older than parameter us old
14 S ANS=1
15QT Q ANS
16 ;
17FMDATE() ;this entry point returns the FM date from the parameter of
18 ;whether to use the new or old structure.
19 Q $P($G(^SD(404.91,1,"AMB")),U,2)
20 ;
21CLOSED(DATE) ;this entry point accepts a date, compares it to the close out
22 ;date and returns whether the close out period is up.
23 ;INPUTS - a date in FM format to be compared to the close out date
24 ; parameter.
25 ;OUTPUTS - 1 for close out period is over
26 ; 0 for still being able to close out
27 ;
28 N PAR,ANS
29 S PAR=$P($G(^SD(404.91,1,"AMB")),U,3) ;gets close out parameter
30 I 'PAR S ANS=0 G CQT
31 I DATE<PAR S ANS=0 G CQT ;if date is after close out date parameter 1.
32 S ANS=1
33CQT Q ANS
34 ;
35CLOSEFM() ;this entry point returns the close out date parameter in FM format.
36 Q $P($G(^SD(404.91,1,"AMB")),U,3)
37 ;
38INPATENC(PTR,PTR2) ;ALB/JRP - Determine if an Outpatient Encounter
39 ; is for an inpatient appointment
40 ;
41 ;Input : PTR - Pointer to one of the following files:
42 ; * TRANSMITTED OUTPATIENT ENCOUNTER file (#409.73)
43 ; * OUTPATIENT ENCOUNTER file (#409.68)
44 ; * DELETED OUTPATIENT ENCOUNTER file (#409.74)
45 ; PTR2 - Denotes which file PTR points to
46 ; 0 = TRANSMITTED OUTPATIENT ENCOUNTER file (Default)
47 ; 1 = OUTPATIENT ENCOUNTER file
48 ; 2 = DELETED OUTPATIENT ENCOUNTER file
49 ;Output : 0 - Encounter is not an inpatient appointment
50 ; 1 - Encounter is an inpatient appointment
51 ;Notes : 0 is returned if a valid pointer is not passed or the
52 ; entry in the TRANSMITTED OUTPATIENT ENCOUNTER file does
53 ; not point to a valid entry in the OUTPATIENT ENCOUNTER
54 ; file or DELETED OUTPATIENT ENCOUNTER file
55 ;
56 ;Check input
57 S PTR=+$G(PTR)
58 Q:('PTR) 0
59 S PTR2=+$G(PTR2)
60 S:((PTR2<0)!(PTR2>2)) PTR2=0
61 I ('PTR) Q:('$D(^SD(409.73,PTR,0))) 0
62 I (PTR2=1) Q:('$D(^SCE(PTR,0))) 0
63 I (PTR2=2) Q:('$D(^SD(409.74,PTR,0))) 0
64 ;Declare variables
65 N ZERONODE,STATPTR,STATUS
66 ;Passed pointer to TRANSMITTED OUTPATIENT ENCOUNTER file
67 ; Convert to pointer to [DELETED] OUTPATIENT ENCOUNTER file
68 ; Quit if it can't be converted
69 I ('PTR2) D Q:('PTR) 0
70 .S ZERONODE=$G(^SD(409.73,PTR,0))
71 .S PTR=+$P(ZERONODE,"^",2)
72 .;Entry is for an outpatient encounter
73 .I (PTR) S PTR2=1 Q
74 .;Entry is for a deleted outpatient encounter
75 .S PTR=+$P(ZERONODE,"^",3)
76 .S PTR2=2
77 ;Get zero node of [deleted] encounter
78 S ZERONODE=$G(^SCE(PTR,0))
79 S:(PTR2=2) ZERONODE=$G(^SD(409.74,PTR,1))
80 ;Get pointer to appointment status
81 S STATPTR=+$P(ZERONODE,"^",12)
82 Q:('STATPTR) 0
83 ;Get zero node of appointment status
84 S ZERONODE=$G(^SD(409.63,STATPTR,0))
85 ;Get abbreviation for appointment status
86 S STATUS=$P(ZERONODE,"^",2)
87 ;Inpatient appointments have an abbreviation of 'I'
88 Q:(STATUS="I") 1
89 ;Not an inpatient appointment
90 Q 0
91 ;
92DATECHK() ;this function call returns whether to require diag/prov based
93 ;on the date function call and whether the post init has run.
94 ;there are no inout variables.
95 ;
96 ;a 1 if after 10/1 or the post init has been run to require diag etc.
97 ;a 0 if not to require yet
98 ;
99 N DATE,ANS
100 S ANS=$$DATE(DT) I ANS G DATECHKQ
101 I $P(^SD(404.91,1,"AMB"),U,7) S ANS=1 G DATECHKQ
102 S ANS=0
103DATECHKQ Q ANS
104 ;
105OCCA(CLN) ;This function call returns whether or not the clinic is
106 ;considered an occasion of service, based upon file 409.45.
107 ;
108 ;CLN is the clinic in question
109 ;
110 ;a 1 if this clinic is an occasion of service clinic
111 ;a 0 if not
112 ;
113 N SCP,SC,ANS
114 I '$D(^SC(CLN,0)) S ANS=0 G OCCAQ
115 S SCP=$P(^SC(CLN,0),U,7)
116 I 'SCP S ANS=0 G OCCAQ
117 I '$D(^DIC(40.7,SCP,0)) S ANS=0 G OCCAQ
118 S SC=$P(^DIC(40.7,SCP,0),U,2)
119 I 'SC S ANS=0 G OCCAQ
120 I '$O(^SD(409.45,"B",SC,"")) S ANS=0 G OCCAQ
121 I "117^118^119^120^121^123^124^125^126^128^152^165^170^999"[SC S ANS=0 G OCCAQ
122 S ANS=1
123OCCAQ Q ANS
Note: See TracBrowser for help on using the repository browser.