DGENA1 ;ALB/CJM,ISA/KWP,KUM - Enrollment API - File Data ;3/31/08 12:18pm
;;5.3;Registration;**121,147,232,671,1027**;Aug 13,1993;Build 70
;PHASE II moved CHECK and TESTVAL to DGENA3
LOCK(DFN) ;
;Description: This lock is used to prevent another process from editing
; a patient's enrollment, including the current enrollment and the
; enrollment history.
;Input:
; DFN - Patient IEN
;Output:
; Function Value - Returns 1 if the lock was successful, 0 otherwise
;
I $G(DFN) L +^DPT("ENROLLMENT",DFN):10
Q $T
UNLOCK(DFN) ;
;Description: Used to release a lock created by $$LOCK.
;Input:
; DFN - Patient IEN
;Output: None
;
I $G(DFN) L -^DPT("ENROLLMENT",DFN)
Q
STORE(DGENR,NOCHECK,ERRMSG) ;
;Description: Used to file a PATIENT ENROLLMENT record. Consistency
; checks are done unless NOCHECK=1.If the
; enrollment passes the consistency checks specified the
; PATIENT ENROLLMENT record will be created and the ien returned.
; If the consistency checks are not passed, or a record can not
; be created, 0 is returned. This call does NOT lock the record -
; call LOCK prior to STORE if the record needs to be locked.
;Input :
; DGENR - this local array represents a PATIENT ENROLLMENT (pass by reference)
; NOCHECK - a flag, if NOCHECK=1 it means the consistency checks were done already, so do not do them again. (optional)
; ERRMSG - error message on failure (optional, pass by reference)
;Output:
; Function Value - returns the ien of the PATIENT ENROLLMENT record
; created if successful , 0 otherwise
N DIC,DA,DIE,Y,DR,DO,DD
;check that enrollment is valid before storing
I $G(NOCHECK)'=1 Q:'$$CHECK^DGENA3(.DGENR,,.ERRMSG) 0
;create a new record
S DIC(0)="",X=DGENR("APP"),DIC="^DGEN(27.11,"
D FILE^DICN
I Y=-1 S ERRMSG="FILEMAN UNABLE TO CREATE ENROLLMENT RECORD" Q 0
S DA=+Y
;if failed to store record, exit
Q:'DA 0
;edit the record
I '$$EDIT^DGENA1A(DA,.DGENR) Q 0
Q DA
STORECUR(DGENR,NOCHECK,ERRMSG) ;
;Description: Used to store an enrollment that has already been created
; as a local array into the PATIENT ENROLLMENT file as the
; patient's current enrollment. If the enrollment passes the
; consistency checks specified the enrollment record will be
; created and the internal entry number returned. If the
; consistency checks are not passed, or a record can not be
; created, 0 will be returned
;Input :
; DGENR - this local array represents a PATIENT ENROLLMENT and should
; be passed by reference.
; NOCHECK - a flag, if NOCHECK=1 it means the consistency checks were done already, so do not do them again. (optional)
;Output:
; Function Value - returns the internal entry number of the PATIENT
; ENROLLMENT record created if successful , 0 otherwise
; ERRMSG - error message on failure (optional, pass by reference)
N DGENRIEN,OK
S OK=1
I '$$LOCK($G(DGENR("DFN"))) S OK=0
D:OK
.S DGENRIEN=$$STORE(.DGENR,$G(NOCHECK),.ERRMSG)
.I 'DGENRIEN S OK=0
.D:OK
..N PRIOR
..;link enrollment record to the prior enrollment
..D:DGENR("PRIORREC") KILL^DGENA1A(27.11,DGENRIEN,.09,DGENR("PRIORREC"))
..S PRIOR=$$FINDCUR^DGENA(DGENR("DFN"))
..S $P(^DGEN(27.11,DGENRIEN,0),"^",9)=PRIOR
..D:PRIOR SET^DGENA1A(27.11,DGENRIEN,.09,PRIOR)
..;now link the patient record to the new current enrollment
..D:PRIOR KILL^DGENA1A(2,DGENR("DFN"),27.01,PRIOR)
..N DGENFDA
..S DGENFDA(2,DGENR("DFN")_",",27.01)=DGENRIEN
..D UPDATE^DIE("","DGENFDA","","ERR")
..; DG*5.3*1027 - set PT APPLIED field - will sync with PATIENT file via trigger
..K DGENFDA
..S DGENFDA(27.11,DGENRIEN_",",.14)=$G(DGENR("PTAPPLIED"))
..D UPDATE^DIE("","DGENFDA","","ERR")
D UNLOCK(DGENR("DFN"))
Q $S(OK:DGENRIEN,1:0)
EDITCUR(DGENR) ;
;Description: Used to store an enrollment that has already been created
; as a local array into the PATIENT ENROLLMENT file as the
; patient's current enrollment. If the enrollment passes the
; consistency checks specified the current enrollment record, if
; it exists, will be overlaid by the enrollment contained in
; DGENR, otherwise, if there is no current enrollment, a new
; patient enrollment record will be created as the current
; enrollment. If the consistency checks are not passed, or a
; record can not be created, NULL will be returned.
;Input :
; DGENR - this local array represents a PATIENT ENROLLMENT and
; should be passed by reference.
;Output:
; Function Value - returns the internal entry number of the PATIENT
; ENROLLMENT record created if successful , 0 otherwise
N DGENRIEN,OK
S OK=$$LOCK($G(DGENR("DFN")))
D:OK
.S DGENRIEN=$$FINDCUR^DGENA(DGENR("DFN"))
.I 'DGENRIEN D
..S OK=$$STORECUR(.DGENR)
.E D
..S OK=$$CHECK^DGENA3(.DGENR)
..I OK S OK=$$EDIT^DGENA1A(DGENRIEN,.DGENR)
..; DG*5.3*1027 - set PT APPLIED field - will sync with PATIENT file via trigger if editing the CURRENT ENROLLEMNT
..I $G(DGENR("PTAPPLIED"))'="" D
...K DGENFDA
...S DGENFDA(27.11,DGENRIEN_",",.14)=$G(DGENR("PTAPPLIED"))
...D UPDATE^DIE("","DGENFDA","","ERR")
D UNLOCK(DGENR("DFN"))
Q $S(OK:DGENRIEN,1:0)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDGENA1 5267 printed Oct 16, 2024@18:42:55 Page 2
DGENA1 ;ALB/CJM,ISA/KWP,KUM - Enrollment API - File Data ;3/31/08 12:18pm
+1 ;;5.3;Registration;**121,147,232,671,1027**;Aug 13,1993;Build 70
+2 ;PHASE II moved CHECK and TESTVAL to DGENA3
LOCK(DFN) ;
+1 ;Description: This lock is used to prevent another process from editing
+2 ; a patient's enrollment, including the current enrollment and the
+3 ; enrollment history.
+4 ;Input:
+5 ; DFN - Patient IEN
+6 ;Output:
+7 ; Function Value - Returns 1 if the lock was successful, 0 otherwise
+8 ;
+9 IF $GET(DFN)
LOCK +^DPT("ENROLLMENT",DFN):10
+10 QUIT $TEST
UNLOCK(DFN) ;
+1 ;Description: Used to release a lock created by $$LOCK.
+2 ;Input:
+3 ; DFN - Patient IEN
+4 ;Output: None
+5 ;
+6 IF $GET(DFN)
LOCK -^DPT("ENROLLMENT",DFN)
+7 QUIT
STORE(DGENR,NOCHECK,ERRMSG) ;
+1 ;Description: Used to file a PATIENT ENROLLMENT record. Consistency
+2 ; checks are done unless NOCHECK=1.If the
+3 ; enrollment passes the consistency checks specified the
+4 ; PATIENT ENROLLMENT record will be created and the ien returned.
+5 ; If the consistency checks are not passed, or a record can not
+6 ; be created, 0 is returned. This call does NOT lock the record -
+7 ; call LOCK prior to STORE if the record needs to be locked.
+8 ;Input :
+9 ; DGENR - this local array represents a PATIENT ENROLLMENT (pass by reference)
+10 ; NOCHECK - a flag, if NOCHECK=1 it means the consistency checks were done already, so do not do them again. (optional)
+11 ; ERRMSG - error message on failure (optional, pass by reference)
+12 ;Output:
+13 ; Function Value - returns the ien of the PATIENT ENROLLMENT record
+14 ; created if successful , 0 otherwise
+15 NEW DIC,DA,DIE,Y,DR,DO,DD
+16 ;check that enrollment is valid before storing
+17 IF $GET(NOCHECK)'=1
if '$$CHECK^DGENA3(.DGENR,,.ERRMSG)
QUIT 0
+18 ;create a new record
+19 SET DIC(0)=""
SET X=DGENR("APP")
SET DIC="^DGEN(27.11,"
+20 DO FILE^DICN
+21 IF Y=-1
SET ERRMSG="FILEMAN UNABLE TO CREATE ENROLLMENT RECORD"
QUIT 0
+22 SET DA=+Y
+23 ;if failed to store record, exit
+24 if 'DA
QUIT 0
+25 ;edit the record
+26 IF '$$EDIT^DGENA1A(DA,.DGENR)
QUIT 0
+27 QUIT DA
STORECUR(DGENR,NOCHECK,ERRMSG) ;
+1 ;Description: Used to store an enrollment that has already been created
+2 ; as a local array into the PATIENT ENROLLMENT file as the
+3 ; patient's current enrollment. If the enrollment passes the
+4 ; consistency checks specified the enrollment record will be
+5 ; created and the internal entry number returned. If the
+6 ; consistency checks are not passed, or a record can not be
+7 ; created, 0 will be returned
+8 ;Input :
+9 ; DGENR - this local array represents a PATIENT ENROLLMENT and should
+10 ; be passed by reference.
+11 ; NOCHECK - a flag, if NOCHECK=1 it means the consistency checks were done already, so do not do them again. (optional)
+12 ;Output:
+13 ; Function Value - returns the internal entry number of the PATIENT
+14 ; ENROLLMENT record created if successful , 0 otherwise
+15 ; ERRMSG - error message on failure (optional, pass by reference)
+16 NEW DGENRIEN,OK
+17 SET OK=1
+18 IF '$$LOCK($GET(DGENR("DFN")))
SET OK=0
+19 if OK
Begin DoDot:1
+20 SET DGENRIEN=$$STORE(.DGENR,$GET(NOCHECK),.ERRMSG)
+21 IF 'DGENRIEN
SET OK=0
+22 if OK
Begin DoDot:2
+23 NEW PRIOR
+24 ;link enrollment record to the prior enrollment
+25 if DGENR("PRIORREC")
DO KILL^DGENA1A(27.11,DGENRIEN,.09,DGENR("PRIORREC"))
+26 SET PRIOR=$$FINDCUR^DGENA(DGENR("DFN"))
+27 SET $PIECE(^DGEN(27.11,DGENRIEN,0),"^",9)=PRIOR
+28 if PRIOR
DO SET^DGENA1A(27.11,DGENRIEN,.09,PRIOR)
+29 ;now link the patient record to the new current enrollment
+30 if PRIOR
DO KILL^DGENA1A(2,DGENR("DFN"),27.01,PRIOR)
+31 NEW DGENFDA
+32 SET DGENFDA(2,DGENR("DFN")_",",27.01)=DGENRIEN
+33 DO UPDATE^DIE("","DGENFDA","","ERR")
+34 ; DG*5.3*1027 - set PT APPLIED field - will sync with PATIENT file via trigger
+35 KILL DGENFDA
+36 SET DGENFDA(27.11,DGENRIEN_",",.14)=$GET(DGENR("PTAPPLIED"))
+37 DO UPDATE^DIE("","DGENFDA","","ERR")
End DoDot:2
End DoDot:1
+38 DO UNLOCK(DGENR("DFN"))
+39 QUIT $SELECT(OK:DGENRIEN,1:0)
EDITCUR(DGENR) ;
+1 ;Description: Used to store an enrollment that has already been created
+2 ; as a local array into the PATIENT ENROLLMENT file as the
+3 ; patient's current enrollment. If the enrollment passes the
+4 ; consistency checks specified the current enrollment record, if
+5 ; it exists, will be overlaid by the enrollment contained in
+6 ; DGENR, otherwise, if there is no current enrollment, a new
+7 ; patient enrollment record will be created as the current
+8 ; enrollment. If the consistency checks are not passed, or a
+9 ; record can not be created, NULL will be returned.
+10 ;Input :
+11 ; DGENR - this local array represents a PATIENT ENROLLMENT and
+12 ; should be passed by reference.
+13 ;Output:
+14 ; Function Value - returns the internal entry number of the PATIENT
+15 ; ENROLLMENT record created if successful , 0 otherwise
+16 NEW DGENRIEN,OK
+17 SET OK=$$LOCK($GET(DGENR("DFN")))
+18 if OK
Begin DoDot:1
+19 SET DGENRIEN=$$FINDCUR^DGENA(DGENR("DFN"))
+20 IF 'DGENRIEN
Begin DoDot:2
+21 SET OK=$$STORECUR(.DGENR)
End DoDot:2
+22 IF '$TEST
Begin DoDot:2
+23 SET OK=$$CHECK^DGENA3(.DGENR)
+24 IF OK
SET OK=$$EDIT^DGENA1A(DGENRIEN,.DGENR)
+25 ; DG*5.3*1027 - set PT APPLIED field - will sync with PATIENT file via trigger if editing the CURRENT ENROLLEMNT
+26 IF $GET(DGENR("PTAPPLIED"))'=""
Begin DoDot:3
+27 KILL DGENFDA
+28 SET DGENFDA(27.11,DGENRIEN_",",.14)=$GET(DGENR("PTAPPLIED"))
+29 DO UPDATE^DIE("","DGENFDA","","ERR")
End DoDot:3
End DoDot:2
End DoDot:1
+30 DO UNLOCK(DGENR("DFN"))
+31 QUIT $SELECT(OK:DGENRIEN,1:0)
