[613] | 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
|
---|