EASWTAPI ; ALB/SCK - ENROLLMENT DATE API - ; 7-12-2002
;;1.0;ENROLLMENT APPLICATION SYSTEM;**17**;MAR 15, 2001
;
ENROLL(DFN) ; Find enrollement date for patient
; Input
; DFN - IEN of the patient file
;
; Output
; 0 - If an enrollment date cannot be determined
; 1^IEN^date^type - If an enrollment date can be determined
;
; 1 - Flag that an enrollment date was determined
; IEN - IEN of the PATIENT ENROLLMENT File entry returned
; date - Date in FileMan internal format
; type - "E" for an ENROLLMENT DATE
; "A" for an ENROLLMENT APPLICATION DATE
;
N RSLT,EAIEN,EAIEN1,EAX,DONE,EAVER,EASTAT,EANODE
;
S RSLT=0
S DFN=$G(DFN) I 'DFN Q RSLT
I '$D(^DPT(DFN,0)) Q RSLT
;
;; Retrieve last enrollment record for patient
S EAIEN="Z",EAIEN=$O(^DGEN(27.11,"C",DFN,EAIEN),-1)
I 'EAIEN Q RSLT
;; If last enrollment record is Cancel/Decline, return 0
I $$GET1^DIQ(27.11,EAIEN,.04,"I")=7 Q $G(RSLT)
;
S RSLT=$$VERIFY(EAIEN)
I 'RSLT S RSLT=$$UNVERIFY(EAIEN)
Q RSLT
;
VERIFY(EAIEN) ; Find latest verified record
N EAX,EANODE,EAVER,RSLT,DONE
;
S EANODE=EAIEN_"~"_$G(^DGEN(27.11,EAIEN,0))
S RSLT=0
S EAVER=$$SEARCH(EANODE,2)
I +$P($G(EAVER),"~",1)>0 D
. S RSLT="1^"_$P(EAVER,"~",1)_U_$P(EAVER,U,10)_"^E"
Q RSLT
;
UNVERIFY(EAIEN) ; Find an un-verified record
N EAX,EANODE,EAUNV,RSLT,DONE
;
S RSLT=0
S EANODE=EAIEN_"~"_$G(^DGEN(27.11,EAIEN,0))
S EAUNV=$$SEARCH(EANODE,1)
I +$P($G(EAUNV),"~",1)>0 D
. S RSLT="1^"_$P(EAUNV,"~",1)_U_$P($P(EAUNV,"~",2),U,1)_"^A"
Q RSLT
;
SEARCH(EANODE,STAT) ; Search for enrollment record
N EACUR,DONE,EAX,EAIEN
;
I $P(EANODE,U,4)=STAT S EACUR=EANODE
F EAX=1:1 D Q:$G(DONE)
. S EAIEN=$P(EANODE,U,9)
. I 'EAIEN S DONE=1 Q
. S EANODE=$G(^DGEN(27.11,EAIEN,0))
. I $P(EANODE,U,4)=STAT S EACUR=EAIEN_"~"_$G(^DGEN(27.11,EAIEN,0))
. I $P(EANODE,U,4)=7 S DONE=1
Q $G(EACUR)
;
CHECK(DFN) ;
N EAX,EAIEN,EANODE,DONE
;
S DFN=$G(DFN) I 'DFN Q
Q:'$D(^DPT(DFN,0))
;
S EAIEN="Z"
S EAIEN=$O(^DGEN(27.11,"C",DFN,EAIEN),-1)
Q:'EAIEN
S EANODE=$G(^DGEN(27.11,EAIEN,0))
W !,EAIEN_" | "_EANODE
;
F EAX=1:1 D Q:$G(DONE)
. S EAIEN=$P(EANODE,U,9)
. I 'EAIEN S DONE=1 Q
. S EANODE=$G(^DGEN(27.11,EAIEN,0))
. W !,EAIEN_" | "_EANODE
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASWTAPI 2317 printed Nov 22, 2024@17:06 Page 2
EASWTAPI ; ALB/SCK - ENROLLMENT DATE API - ; 7-12-2002
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**17**;MAR 15, 2001
+2 ;
ENROLL(DFN) ; Find enrollement date for patient
+1 ; Input
+2 ; DFN - IEN of the patient file
+3 ;
+4 ; Output
+5 ; 0 - If an enrollment date cannot be determined
+6 ; 1^IEN^date^type - If an enrollment date can be determined
+7 ;
+8 ; 1 - Flag that an enrollment date was determined
+9 ; IEN - IEN of the PATIENT ENROLLMENT File entry returned
+10 ; date - Date in FileMan internal format
+11 ; type - "E" for an ENROLLMENT DATE
+12 ; "A" for an ENROLLMENT APPLICATION DATE
+13 ;
+14 NEW RSLT,EAIEN,EAIEN1,EAX,DONE,EAVER,EASTAT,EANODE
+15 ;
+16 SET RSLT=0
+17 SET DFN=$GET(DFN)
IF 'DFN
QUIT RSLT
+18 IF '$DATA(^DPT(DFN,0))
QUIT RSLT
+19 ;
+20 ;; Retrieve last enrollment record for patient
+21 SET EAIEN="Z"
SET EAIEN=$ORDER(^DGEN(27.11,"C",DFN,EAIEN),-1)
+22 IF 'EAIEN
QUIT RSLT
+23 ;; If last enrollment record is Cancel/Decline, return 0
+24 IF $$GET1^DIQ(27.11,EAIEN,.04,"I")=7
QUIT $GET(RSLT)
+25 ;
+26 SET RSLT=$$VERIFY(EAIEN)
+27 IF 'RSLT
SET RSLT=$$UNVERIFY(EAIEN)
+28 QUIT RSLT
+29 ;
VERIFY(EAIEN) ; Find latest verified record
+1 NEW EAX,EANODE,EAVER,RSLT,DONE
+2 ;
+3 SET EANODE=EAIEN_"~"_$GET(^DGEN(27.11,EAIEN,0))
+4 SET RSLT=0
+5 SET EAVER=$$SEARCH(EANODE,2)
+6 IF +$PIECE($GET(EAVER),"~",1)>0
Begin DoDot:1
+7 SET RSLT="1^"_$PIECE(EAVER,"~",1)_U_$PIECE(EAVER,U,10)_"^E"
End DoDot:1
+8 QUIT RSLT
+9 ;
UNVERIFY(EAIEN) ; Find an un-verified record
+1 NEW EAX,EANODE,EAUNV,RSLT,DONE
+2 ;
+3 SET RSLT=0
+4 SET EANODE=EAIEN_"~"_$GET(^DGEN(27.11,EAIEN,0))
+5 SET EAUNV=$$SEARCH(EANODE,1)
+6 IF +$PIECE($GET(EAUNV),"~",1)>0
Begin DoDot:1
+7 SET RSLT="1^"_$PIECE(EAUNV,"~",1)_U_$PIECE($PIECE(EAUNV,"~",2),U,1)_"^A"
End DoDot:1
+8 QUIT RSLT
+9 ;
SEARCH(EANODE,STAT) ; Search for enrollment record
+1 NEW EACUR,DONE,EAX,EAIEN
+2 ;
+3 IF $PIECE(EANODE,U,4)=STAT
SET EACUR=EANODE
+4 FOR EAX=1:1
Begin DoDot:1
+5 SET EAIEN=$PIECE(EANODE,U,9)
+6 IF 'EAIEN
SET DONE=1
QUIT
+7 SET EANODE=$GET(^DGEN(27.11,EAIEN,0))
+8 IF $PIECE(EANODE,U,4)=STAT
SET EACUR=EAIEN_"~"_$GET(^DGEN(27.11,EAIEN,0))
+9 IF $PIECE(EANODE,U,4)=7
SET DONE=1
End DoDot:1
if $GET(DONE)
QUIT
+10 QUIT $GET(EACUR)
+11 ;
CHECK(DFN) ;
+1 NEW EAX,EAIEN,EANODE,DONE
+2 ;
+3 SET DFN=$GET(DFN)
IF 'DFN
QUIT
+4 if '$DATA(^DPT(DFN,0))
QUIT
+5 ;
+6 SET EAIEN="Z"
+7 SET EAIEN=$ORDER(^DGEN(27.11,"C",DFN,EAIEN),-1)
+8 if 'EAIEN
QUIT
+9 SET EANODE=$GET(^DGEN(27.11,EAIEN,0))
+10 WRITE !,EAIEN_" | "_EANODE
+11 ;
+12 FOR EAX=1:1
Begin DoDot:1
+13 SET EAIEN=$PIECE(EANODE,U,9)
+14 IF 'EAIEN
SET DONE=1
QUIT
+15 SET EANODE=$GET(^DGEN(27.11,EAIEN,0))
+16 WRITE !,EAIEN_" | "_EANODE
End DoDot:1
if $GET(DONE)
QUIT
+17 QUIT
