QAOC0 ;HISC/DAD-OCCURRENCE SCREEN AUTO ENROLLMENT ; 6/11/14 10:16am
;;3.0;Occurrence Screen;**9**;09/14/1993;Build 4
;AUTO ENROLL UTILITIES
;
TXSP(CARETYPE,TXSP) ; Is TXSP of type CARETYPE ?
; Returns: -1 = No, >0 = Yes
; TXSP = A facility treating specialty file (#45.7) IEN
; CARETYPE = $S(A:Acute, S:Special, I:Intermediate, N:NHCU, P:Psych)
N Y S Y=1
I (TXSP'>0)!(CARETYPE="") S Y=-1 Q Y
I $D(^DIC(45.7,TXSP,0))["0" S Y=-1 Q Y
S TXSP=$O(^QA(741.9,"B",TXSP,0)) I TXSP'>0 S Y=-1 Q Y
S CARETYPE(0)=$P($G(^QA(741.9,TXSP,0)),"^",2)
I CARETYPE(0)="" S Y=-1 Q Y
S:CARETYPE'[CARETYPE(0) Y=-1
Q Y
;
SCHED(DFN,DATE) ; Is DATE a scheduled admission for DFN ?
; Returns: 1 = Yes, 0 = No
; DFN = Patient file (#2) IEN
; DATE = A date in internal FM form
N S0,SCHED,X S SCHED=0,DATE=DATE\1
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
Q:SCHED SCHED
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
Q SCHED
;
SCHED2(DFN,DATE) ; Is DATE a scheduled admission for DFN ? DATE includes TIME (QAO*3*9)
; Returns: 1 = Yes, 0 = No
; DFN = Patient file (#2) IEN
; DATE = A date in internal FM form
N QAOS0,QAOSCHED,QAOX S QAOSCHED=0
F QAOS0=0:0 S QAOS0=$O(^DGS(41.1,"B",DFN,QAOS0)) Q:QAOS0'>0 S QAOX=$G(^DGS(41.1,QAOS0,0)) I $P(QAOX,"^",2)=DATE,+$P(QAOX,"^",13)=0 S QAOSCHED=1 Q
Q:QAOSCHED QAOSCHED
F QAOS0=DATE-.0000001:0 S QAOS0=$O(^DPT(DFN,"S",QAOS0)) Q:$S(QAOS0'>0:1,QAOS0>(DATE+.24):1,QAOS0\1'?7N:1,1:0) S QAOX=$G(^DPT(DFN,"S",QAOS0,0)) I "I"[$P(QAOX,"^",2),$P(QAOX,"^",7)=3,$O(^QA(740,1,"OS1","B",+$P(QAOX,"^"),0)) S QAOSCHED=1 Q
Q QAOSCHED
;
INACTIVE(SCRN) ; Is SCRN national, local, or inactive ?
; Returns: $S(N:National, L:Local, 1:Inactive)
; SCRN = Screen file (#741.1) IEN
S SCRN=$O(^QA(741.1,"B",SCRN,0))
Q $P($G(^QA(741.1,+SCRN,0)),"^",4)
;
VADPT(DFN,IEN405) ; For DFN get movement number IEN405 data
; DFN = Patient file (#2) IEN
; IEN405 = Patient movement file (#405) IEN
D KVAR^VADPT S VAIP("E")=IEN405 D IN5^VADPT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HQAOC0 2251 printed Dec 13, 2024@02:20:57 Page 2
QAOC0 ;HISC/DAD-OCCURRENCE SCREEN AUTO ENROLLMENT ; 6/11/14 10:16am
+1 ;;3.0;Occurrence Screen;**9**;09/14/1993;Build 4
+2 ;AUTO ENROLL UTILITIES
+3 ;
TXSP(CARETYPE,TXSP) ; Is TXSP of type CARETYPE ?
+1 ; Returns: -1 = No, >0 = Yes
+2 ; TXSP = A facility treating specialty file (#45.7) IEN
+3 ; CARETYPE = $S(A:Acute, S:Special, I:Intermediate, N:NHCU, P:Psych)
+4 NEW Y
SET Y=1
+5 IF (TXSP'>0)!(CARETYPE="")
SET Y=-1
QUIT Y
+6 IF $DATA(^DIC(45.7,TXSP,0))["0"
SET Y=-1
QUIT Y
+7 SET TXSP=$ORDER(^QA(741.9,"B",TXSP,0))
IF TXSP'>0
SET Y=-1
QUIT Y
+8 SET CARETYPE(0)=$PIECE($GET(^QA(741.9,TXSP,0)),"^",2)
+9 IF CARETYPE(0)=""
SET Y=-1
QUIT Y
+10 if CARETYPE'[CARETYPE(0)
SET Y=-1
+11 QUIT Y
+12 ;
SCHED(DFN,DATE) ; Is DATE a scheduled admission for DFN ?
+1 ; Returns: 1 = Yes, 0 = No
+2 ; DFN = Patient file (#2) IEN
+3 ; DATE = A date in internal FM form
+4 NEW S0,SCHED,X
SET SCHED=0
SET DATE=DATE\1
+5 FOR S0=0:0
SET S0=$ORDER(^DGS(41.1,"B",DFN,S0))
if S0'>0
QUIT
SET X=$GET(^DGS(41.1,S0,0))
IF $PIECE(X,"^",2)\1=DATE
IF +$PIECE(X,"^",13)=0
SET SCHED=1
QUIT
+6 if SCHED
QUIT SCHED
+7 FOR S0=DATE-.0000001:0
SET S0=$ORDER(^DPT(DFN,"S",S0))
if $SELECT(S0'>0
QUIT
SET X=$GET(^DPT(DFN,"S",S0,0))
IF "I"[$PIECE(X,"^",2)
IF $PIECE(X,"^",7)=3
IF $ORDER(^QA(740,1,"OS1","B",+$PIECE(X,"^"),0))
SET SCHED=1
QUIT
+8 QUIT SCHED
+9 ;
SCHED2(DFN,DATE) ; Is DATE a scheduled admission for DFN ? DATE includes TIME (QAO*3*9)
+1 ; Returns: 1 = Yes, 0 = No
+2 ; DFN = Patient file (#2) IEN
+3 ; DATE = A date in internal FM form
+4 NEW QAOS0,QAOSCHED,QAOX
SET QAOSCHED=0
+5 FOR QAOS0=0:0
SET QAOS0=$ORDER(^DGS(41.1,"B",DFN,QAOS0))
if QAOS0'>0
QUIT
SET QAOX=$GET(^DGS(41.1,QAOS0,0))
IF $PIECE(QAOX,"^",2)=DATE
IF +$PIECE(QAOX,"^",13)=0
SET QAOSCHED=1
QUIT
+6 if QAOSCHED
QUIT QAOSCHED
+7 FOR QAOS0=DATE-.0000001:0
SET QAOS0=$ORDER(^DPT(DFN,"S",QAOS0))
if $SELECT(QAOS0'>0
QUIT
SET QAOX=$GET(^DPT(DFN,"S",QAOS0,0))
IF "I"[$PIECE(QAOX,"^",2)
IF $PIECE(QAOX,"^",7)=3
IF $ORDER(^QA(740,1,"OS1","B",+$PIECE(QAOX,"^"),0))
SET QAOSCHED=1
QUIT
+8 QUIT QAOSCHED
+9 ;
INACTIVE(SCRN) ; Is SCRN national, local, or inactive ?
+1 ; Returns: $S(N:National, L:Local, 1:Inactive)
+2 ; SCRN = Screen file (#741.1) IEN
+3 SET SCRN=$ORDER(^QA(741.1,"B",SCRN,0))
+4 QUIT $PIECE($GET(^QA(741.1,+SCRN,0)),"^",4)
+5 ;
VADPT(DFN,IEN405) ; For DFN get movement number IEN405 data
+1 ; DFN = Patient file (#2) IEN
+2 ; IEN405 = Patient movement file (#405) IEN
+3 DO KVAR^VADPT
SET VAIP("E")=IEN405
DO IN5^VADPT
+4 QUIT
