1 | SCDXFX01 ;ALB/JRP - AMBULATORY CARE FILE X-REFS & UTILS;30-APR-1996
|
---|
2 | ;;5.3;Scheduling;**44,99**;AUG 13, 1993
|
---|
3 | ;
|
---|
4 | AACXMIT(IFN,SET,OLDDATE) ;Logic for AACXMIT* cross references of
|
---|
5 | ; TRANSMITTED OUTPATIENT ENCOUNTER file (#409.73)
|
---|
6 | ;
|
---|
7 | ;Input : IFN - Pointer to entry in file
|
---|
8 | ; SET - If 1, set cross reference
|
---|
9 | ; If 0, kill cross reference
|
---|
10 | ; If -1, check the current value of TRANSMISSION
|
---|
11 | ; REQUIRED field (#.04), setting the cross reference
|
---|
12 | ; if a value of 'YES' is found and killing the
|
---|
13 | ; cross reference if a value of 'NO' is found
|
---|
14 | ; (DEFAULT)
|
---|
15 | ; OLDDATE - Previous value of DATE/TIME OF EVENT field (#.06)
|
---|
16 | ; - Only valid when KILLing the x-ref is due to the
|
---|
17 | ; DATE/TIME OF EVENT field (#.06) changing
|
---|
18 | ;Output : None
|
---|
19 | ;
|
---|
20 | ;Check input
|
---|
21 | Q:('$G(IFN))
|
---|
22 | Q:('$D(^SD(409.73,IFN)))
|
---|
23 | S:($G(SET)="") SET=-1
|
---|
24 | S OLDDATE=+$G(OLDDATE)
|
---|
25 | ;Declare variables
|
---|
26 | N ZERO,EVENT,EVNTDATE,XMIT
|
---|
27 | ;Get zero node
|
---|
28 | S ZERO=$G(^SD(409.73,IFN,0))
|
---|
29 | ;Get value of TRANSMISSION REQUIRED field
|
---|
30 | S XMIT=+$P(ZERO,"^",4)
|
---|
31 | ;Set/kill logic based on value of TRANSMISSION REQUIRED
|
---|
32 | S:(SET=-1) SET=$S(XMIT=1:1,1:0)
|
---|
33 | ;Get event date/time
|
---|
34 | S EVNTDATE=+$P(ZERO,"^",6)
|
---|
35 | ;Use old event date/time if killing due to this value changing
|
---|
36 | S:(('SET)&(OLDDATE)) EVNTDATE=OLDDATE
|
---|
37 | ;No event date/time - don't set x-ref
|
---|
38 | Q:('EVNTDATE)
|
---|
39 | ;Setting of x-ref is screened so x-ref is only set on add, edit,
|
---|
40 | ; delete, and retransmit events
|
---|
41 | S EVENT=+$P(ZERO,"^",5)
|
---|
42 | I (SET) Q:((EVENT>3)!(EVENT<0)) S ^SD(409.73,"AACXMIT",EVNTDATE,IFN)=""
|
---|
43 | ;Kill x-ref
|
---|
44 | K:('SET) ^SD(409.73,"AACXMIT",EVNTDATE,IFN)
|
---|
45 | Q
|
---|
46 | ;
|
---|
47 | AACNA(IFN,SET,OLDDATE) ;Logic for AACNA* cross references of TRANSMITTED
|
---|
48 | ; OUTPATIENT ENCOUNTER file (#409.73)
|
---|
49 | ;
|
---|
50 | ;Input : IFN - Pointer to entry in file
|
---|
51 | ; SET - If 1, set cross reference
|
---|
52 | ; If 0, kill cross reference (DEFAULT)
|
---|
53 | ; OLDDATE - Previous value of DATE/TIME OF XMIT TO NPCDB
|
---|
54 | ; field (#11)
|
---|
55 | ; - Only valid when KILLing the x-ref is due to the
|
---|
56 | ; DATE/TIME OF XMIT TO NPCDB field (#11) changing
|
---|
57 | ;Output : None
|
---|
58 | ;
|
---|
59 | ;Check input
|
---|
60 | Q:('$G(IFN))
|
---|
61 | Q:('$D(^SD(409.73,IFN)))
|
---|
62 | S SET=+$G(SET)
|
---|
63 | S OLDDATE=+$G(OLDDATE)
|
---|
64 | ;Declare variables
|
---|
65 | N NODE,XMITDATE
|
---|
66 | ;Get node
|
---|
67 | S NODE=$G(^SD(409.73,IFN,1))
|
---|
68 | ;Get date/time of transmission
|
---|
69 | S XMITDATE=+$P(NODE,"^",1)
|
---|
70 | ;Use old date/time of transmission if this changed
|
---|
71 | S:(('SET)&(OLDDATE)) XMITDATE=OLDDATE
|
---|
72 | ;No transmission date/time - don't set x-ref
|
---|
73 | Q:('XMITDATE)
|
---|
74 | ;Set x-ref
|
---|
75 | S:(SET) ^SD(409.73,"AACNOACK",XMITDATE,IFN)=""
|
---|
76 | ;Kill x-ref
|
---|
77 | K:('SET) ^SD(409.73,"AACNOACK",XMITDATE,IFN)
|
---|
78 | Q
|
---|
79 | ;
|
---|
80 | AUTO() ;Auto-numbering logic for TRANSMITTED OUTPATIENT ENCOUNTER file
|
---|
81 | ;
|
---|
82 | ;Input : None
|
---|
83 | ;Output : N - Next value to use for NUMBER field (#.01) of
|
---|
84 | ; TRANSMITTED OUTPATIENT ENCOUNTER file (#409.73)
|
---|
85 | ;Note : Auto-numbering logic is based on the LAST XMIT OUTPAT
|
---|
86 | ; ENC NUMBER field (#701.01) of the SCHEDULING PARAMETER
|
---|
87 | ; file (#404.91)
|
---|
88 | ;
|
---|
89 | ;Declare variables
|
---|
90 | N NEXT,SUCCESS
|
---|
91 | ;Lock node to prevent simultaneous use
|
---|
92 | L +^SD(404.91,1,"AMB"):1800 S SUCCESS=$S(($T):1,1:0)
|
---|
93 | Q:('SUCCESS) 0
|
---|
94 | ;Get last value used and increment by 1
|
---|
95 | S NEXT=1+$G(^SD(404.91,1,"AMB"))
|
---|
96 | ;Make sure value hasn't already been used
|
---|
97 | I $D(^SD(409.73,"B",NEXT)) F NEXT=NEXT:1 Q:('$D(^SD(409.73,"B",NEXT)))
|
---|
98 | ;Store new value
|
---|
99 | S $P(^SD(404.91,1,"AMB"),"^",1)=NEXT
|
---|
100 | ;Unlock node
|
---|
101 | L -^SD(404.91,1,"AMB")
|
---|
102 | ;Return value to use
|
---|
103 | Q NEXT
|
---|