- 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 Mar 13, 2025@21:00:33 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
