| 1 | QAOC0 ;HISC/DAD-OCCURRENCE SCREEN AUTO ENROLLMENT ;10/19/92 14:29
|
|---|
| 2 | ;;3.0;Occurrence Screen;;09/14/1993
|
|---|
| 3 | ;AUTO ENROLL UTILITIES
|
|---|
| 4 | ;
|
|---|
| 5 | TXSP(CARETYPE,TXSP) ; Is TXSP of type CARETYPE ?
|
|---|
| 6 | ; Returns: -1 = No, >0 = Yes
|
|---|
| 7 | ; TXSP = A facility treating specialty file (#45.7) IEN
|
|---|
| 8 | ; CARETYPE = $S(A:Acute, S:Special, I:Intermediate, N:NHCU, P:Psych)
|
|---|
| 9 | N Y S Y=1
|
|---|
| 10 | I (TXSP'>0)!(CARETYPE="") S Y=-1 Q Y
|
|---|
| 11 | I $D(^DIC(45.7,TXSP,0))["0" S Y=-1 Q Y
|
|---|
| 12 | S TXSP=$O(^QA(741.9,"B",TXSP,0)) I TXSP'>0 S Y=-1 Q Y
|
|---|
| 13 | S CARETYPE(0)=$P($G(^QA(741.9,TXSP,0)),"^",2)
|
|---|
| 14 | I CARETYPE(0)="" S Y=-1 Q Y
|
|---|
| 15 | S:CARETYPE'[CARETYPE(0) Y=-1
|
|---|
| 16 | Q Y
|
|---|
| 17 | ;
|
|---|
| 18 | SCHED(DFN,DATE) ; Is DATE a scheduled admission for DFN ?
|
|---|
| 19 | ; Returns: 1 = Yes, 0 = No
|
|---|
| 20 | ; DFN = Patient file (#2) IEN
|
|---|
| 21 | ; DATE = A date in internal FM form
|
|---|
| 22 | N S0,SCHED,X S SCHED=0,DATE=DATE\1
|
|---|
| 23 | F S0=0:0 S S0=$O(^DGS(41.1,"B",DFN,S0)) Q:S0'>0 S X=$G(^DGS(41.1,S0,0)) I $P(X,"^",2)\1=DATE,+$P(X,"^",13)=0 S SCHED=1 Q
|
|---|
| 24 | Q:SCHED SCHED
|
|---|
| 25 | F S0=DATE-.0000001:0 S S0=$O(^DPT(DFN,"S",S0)) Q:$S(S0'>0:1,S0>(DATE+.24):1,S0\1'?7N:1,1:0) S X=$G(^DPT(DFN,"S",S0,0)) I "I"[$P(X,"^",2),$P(X,"^",7)=3,$O(^QA(740,1,"OS1","B",+$P(X,"^"),0)) S SCHED=1 Q
|
|---|
| 26 | Q SCHED
|
|---|
| 27 | ;
|
|---|
| 28 | INACTIVE(SCRN) ; Is SCRN national, local, or inactive ?
|
|---|
| 29 | ; Returns: $S(N:National, L:Local, 1:Inactive)
|
|---|
| 30 | ; SCRN = Screen file (#741.1) IEN
|
|---|
| 31 | S SCRN=$O(^QA(741.1,"B",SCRN,0))
|
|---|
| 32 | Q $P($G(^QA(741.1,+SCRN,0)),"^",4)
|
|---|
| 33 | ;
|
|---|
| 34 | VADPT(DFN,IEN405) ; For DFN get movement number IEN405 data
|
|---|
| 35 | ; DFN = Patient file (#2) IEN
|
|---|
| 36 | ; IEN405 = Patient movement file (#405) IEN
|
|---|
| 37 | D KVAR^VADPT S VAIP("E")=IEN405 D IN5^VADPT
|
|---|
| 38 | Q
|
|---|
