DGENA ;ALB/CJM,ISA/KWP,Zoltan,LBD,CKN,EG,ERC - Enrollment API - Retrieve Data ; 8/15/08 11:08am
;;5.3;PIMS;**121,122,147,232,314,564,672,659,653,688,1015,1016**;JUN 30, 2012;Build 20
;
FINDCUR(DFN) ;
;Description: Used to find a patients current enrollment.
;Input :
; DFN - Patient IEN
;Output:
; Function Value - returns the internal entry number of the patient's
; current enrollment if there is one, NULL otherwise. Checks that
; current enrollment actually belongs to the patient.
;
Q:'$G(DFN) ""
;
N CUR
S CUR=$P($G(^DPT(DFN,"ENR")),"^")
I CUR,$P($G(^DGEN(27.11,CUR,0)),"^",2)'=DFN S CUR=""
Q CUR
;
FINDPRI(DGENRIEN) ;
;Description: Used to obtain a patient's enrollment record that was
; prior to the enrollment identified by DGENRIEN.
;Input :
; DGENRIEN - this is the internal entry number of a PATIENT ENROLLMENT
; record
;Output:
; Function Value - returns the internal entry number of the prior
; enrollment for the patient if there is one, NULL otherwise.
;
Q:'$G(DGENRIEN) ""
Q $P($G(^DGEN(27.11,DGENRIEN,0)),"^",9)
;
ENROLLED(DFN) ;
;Description: Returns whether the patient is currently enrolled.
;Input:
; DFN - Patient IEN
;Output:
; Function Value - returns 1 if the patient is currently enrolled with
; a status of VERIFIED, 0 otherwise
;
N STATUS
S STATUS=$$STATUS($G(DFN))
I (STATUS=2) Q 1
Q 0
;
STATUS(DFN) ;
;Description: Returns ENROLLMENT STATUS from the patient's current
; enrollment.
;Input:
; DFN - Patient IEN
;Output:
; Function Value - If the patient has a current ENROLLMENT STATUS this
; function will return its value, otherwise it returns NULL.
N DGENRIEN
S DGENRIEN=$$FINDCUR($G(DFN))
Q:'DGENRIEN ""
Q $P($G(^DGEN(27.11,DGENRIEN,0)),"^",4)
;
PRIORITY(DFN) ;
;Description: Returns ENROLLMENT PRIORITY from the patient's current
; enrollment.
;Input:
; DFN - Patient IEN
;Output:
; Function Value - If the patient has a current ENROLLMENT PRIORITY
; this function will return its value, otherwise it returns NULL.
N DGENRIEN
S DGENRIEN=$$FINDCUR($G(DFN))
Q:'DGENRIEN ""
Q $P($G(^DGEN(27.11,DGENRIEN,0)),"^",7)
;
SOURCE(DFN) ;
;Description: Returns SOURCE OF ENROLLMENT from the patient's current
; enrollment.
;Input:
; DFN - Patient IEN
;Output:
; Function Value - If the patient has a current ENROLLMENT
; this function will return the SOURCE OF ENROLLMENT, otherwise
; it returns NULL.
;
N DGENRIEN
S DGENRIEN=$$FINDCUR($G(DFN))
Q:'DGENRIEN ""
Q $P($G(^DGEN(27.11,DGENRIEN,0)),"^",3)
;
GET(DGENRIEN,DGENR) ;
;Description: Used to obtain a record from the Patient Enrollment file
; into the local DGENR array.
;Input :
; DGENRIEN - this is the internal entry number of a PATIENT ENROLLMENT record
;Output:
; Function Value - returns 1 on success, 0 on failure.
; DGENR - this is the name of a local array, it should be passed by
; reference. If the function is successful this array will
; contain the enrollment.
;
; subscript field name
; "APP" Enrollment Applicaiton Date
; "DATE" Enrollment Date
; "END" Enrollment End Date
; "DFN" Patient IEN
; "SOURCE" Enrollment Source
; "STATUS" Enrollment Status
; "REASON" Reason Canceled/Declined
; "REMARKS" Canceled/Declined Remarks
; "FACREC" Facility Received
; "PRIORITY" Enrollment Priority
; "SUBGRP" Enrollment Sub-Group
; "EFFDATE" Effective Date
; "PRIORREC" Prior Enrollment Record
; "ELIG","CODE" Primary Eligibility Code
; "ELIG","CODE",<code ien> Eligibility Codes
; "ELIG","SC" Service Connected
; "ELIG","SCPER" Service Connected Percentage
; "ELIG","POW" POW Status Indicated
; "ELIG","A&A" Receiving A&A Benefits
; "ELIG","HB" Receiving Housebound Benefits
; "ELIG","VAPEN" Receiving a VA Pension
; "ELIG","VACKAMT" Total Annual VA Check Amount
; "ELIG","DISRET" Military Disability Retirement
; "ELIG","DISLOD" Discharged Due to Disability
; "ELIG","MEDICAID" Medicaid
; "ELIG","AO" Exposed to Agent Orange
; "ELIG","AOEXPLOC" Agent Orange Exposure Location
; "ELIG","IR" Radiation Exposure Indicated
; "ELIG","RADEXPM" Radiation Exposure Method
; "ELIG","EC" SW Asia Cond - was Env Con, DG*5.3*688
; "ELIG","MTSTA" Means Test Status
; "ELIG","VCD" Veteran Catastrophically Disabled?
; "ELIG","PH" Purple Heart Indicated?
; "ELIG","UNEMPLOY" Unemployable
; "ELIG","CVELEDT" Combat Veteran End Date
; "ELIG","SHAD" SHAD Indicated
; "DATETIME" Date/Time Entered
; "USER" Entered By
;
N SUB,NODE
I '$G(DGENRIEN) Q 0
I '$D(^DGEN(27.11,DGENRIEN,0)) Q 0
K DGENR
S DGENR=""
S NODE=$G(^DGEN(27.11,DGENRIEN,0))
S DGENR("APP")=$P(NODE,"^")
S DGENR("DATE")=$P(NODE,"^",10)
S DGENR("END")=$P(NODE,"^",11)
S DGENR("DFN")=$P(NODE,"^",2)
S DGENR("SOURCE")=$P(NODE,"^",3)
S DGENR("STATUS")=$P(NODE,"^",4)
S DGENR("REASON")=$P(NODE,"^",5)
S DGENR("FACREC")=$P(NODE,"^",6)
S DGENR("PRIORITY")=$P(NODE,"^",7)
S DGENR("EFFDATE")=$P(NODE,"^",8)
S DGENR("PRIORREC")=$P(NODE,"^",9)
;Phase II Get enrollment sub-grp (SRS 6.4)
S DGENR("SUBGRP")=$P(NODE,"^",12)
S NODE=$G(^DGEN(27.11,DGENRIEN,"R"))
S DGENR("REMARKS")=$P(NODE,"^")
S NODE=$G(^DGEN(27.11,DGENRIEN,"E"))
S DGENR("ELIG","CODE")=$P(NODE,"^")
S DGENR("ELIG","SC")=$P(NODE,"^",2)
S DGENR("ELIG","SCPER")=$P(NODE,"^",3)
S DGENR("ELIG","POW")=$P(NODE,"^",4)
S DGENR("ELIG","A&A")=$P(NODE,"^",5)
S DGENR("ELIG","HB")=$P(NODE,"^",6)
S DGENR("ELIG","VAPEN")=$P(NODE,"^",7)
S DGENR("ELIG","VACKAMT")=$P(NODE,"^",8)
S DGENR("ELIG","DISRET")=$P(NODE,"^",9)
S DGENR("ELIG","DISLOD")=$P(NODE,"^",20) ;added with DG*5.3*672
S DGENR("ELIG","MEDICAID")=$P(NODE,"^",10)
S DGENR("ELIG","AO")=$P(NODE,"^",11)
S DGENR("ELIG","AOEXPLOC")=$P(NODE,"^",22) ;added with DG*5.3*688
S DGENR("ELIG","IR")=$P(NODE,"^",12)
S DGENR("ELIG","EC")=$P(NODE,"^",13)
S DGENR("ELIG","MTSTA")=$P(NODE,"^",14)
S DGENR("ELIG","VCD")=$P(NODE,"^",15)
S DGENR("ELIG","PH")=$P(NODE,"^",16)
S DGENR("ELIG","UNEMPLOY")=$P(NODE,"^",17)
S DGENR("ELIG","CVELEDT")=$P(NODE,"^",18)
S DGENR("ELIG","SHAD")=$P(NODE,"^",19)
S DGENR("ELIG","RADEXPM")=$P(NODE,"^",21)
;S DGENCDZZ=1 ; for CD Testing (disabled).
S NODE=$G(^DGEN(27.11,DGENRIEN,"U"))
S DGENR("DATETIME")=$P(NODE,"^")
S DGENR("USER")=$P(NODE,"^",2)
Q 1
;
DGENA ;ALB/CJM,ISA/KWP,Zoltan,LBD,CKN,EG,ERC - Enrollment API - Retrieve Data ; 8/15/08 11:08am
+1 ;;5.3;PIMS;**121,122,147,232,314,564,672,659,653,688,1015,1016**;JUN 30, 2012;Build 20
+2 ;
FINDCUR(DFN) ;
+1 ;Description: Used to find a patients current enrollment.
+2 ;Input :
+3 ; DFN - Patient IEN
+4 ;Output:
+5 ; Function Value - returns the internal entry number of the patient's
+6 ; current enrollment if there is one, NULL otherwise. Checks that
+7 ; current enrollment actually belongs to the patient.
+8 ;
+9 IF '$GET(DFN)
QUIT ""
+10 ;
+11 NEW CUR
+12 SET CUR=$PIECE($GET(^DPT(DFN,"ENR")),"^")
+13 IF CUR
IF $PIECE($GET(^DGEN(27.11,CUR,0)),"^",2)'=DFN
SET CUR=""
+14 QUIT CUR
+15 ;
FINDPRI(DGENRIEN) ;
+1 ;Description: Used to obtain a patient's enrollment record that was
+2 ; prior to the enrollment identified by DGENRIEN.
+3 ;Input :
+4 ; DGENRIEN - this is the internal entry number of a PATIENT ENROLLMENT
+5 ; record
+6 ;Output:
+7 ; Function Value - returns the internal entry number of the prior
+8 ; enrollment for the patient if there is one, NULL otherwise.
+9 ;
+10 IF '$GET(DGENRIEN)
QUIT ""
+11 QUIT $PIECE($GET(^DGEN(27.11,DGENRIEN,0)),"^",9)
+12 ;
ENROLLED(DFN) ;
+1 ;Description: Returns whether the patient is currently enrolled.
+2 ;Input:
+3 ; DFN - Patient IEN
+4 ;Output:
+5 ; Function Value - returns 1 if the patient is currently enrolled with
+6 ; a status of VERIFIED, 0 otherwise
+7 ;
+8 NEW STATUS
+9 SET STATUS=$$STATUS($GET(DFN))
+10 IF (STATUS=2)
QUIT 1
+11 QUIT 0
+12 ;
STATUS(DFN) ;
+1 ;Description: Returns ENROLLMENT STATUS from the patient's current
+2 ; enrollment.
+3 ;Input:
+4 ; DFN - Patient IEN
+5 ;Output:
+6 ; Function Value - If the patient has a current ENROLLMENT STATUS this
+7 ; function will return its value, otherwise it returns NULL.
+8 NEW DGENRIEN
+9 SET DGENRIEN=$$FINDCUR($GET(DFN))
+10 IF 'DGENRIEN
QUIT ""
+11 QUIT $PIECE($GET(^DGEN(27.11,DGENRIEN,0)),"^",4)
+12 ;
PRIORITY(DFN) ;
+1 ;Description: Returns ENROLLMENT PRIORITY from the patient's current
+2 ; enrollment.
+3 ;Input:
+4 ; DFN - Patient IEN
+5 ;Output:
+6 ; Function Value - If the patient has a current ENROLLMENT PRIORITY
+7 ; this function will return its value, otherwise it returns NULL.
+8 NEW DGENRIEN
+9 SET DGENRIEN=$$FINDCUR($GET(DFN))
+10 IF 'DGENRIEN
QUIT ""
+11 QUIT $PIECE($GET(^DGEN(27.11,DGENRIEN,0)),"^",7)
+12 ;
SOURCE(DFN) ;
+1 ;Description: Returns SOURCE OF ENROLLMENT from the patient's current
+2 ; enrollment.
+3 ;Input:
+4 ; DFN - Patient IEN
+5 ;Output:
+6 ; Function Value - If the patient has a current ENROLLMENT
+7 ; this function will return the SOURCE OF ENROLLMENT, otherwise
+8 ; it returns NULL.
+9 ;
+10 NEW DGENRIEN
+11 SET DGENRIEN=$$FINDCUR($GET(DFN))
+12 IF 'DGENRIEN
QUIT ""
+13 QUIT $PIECE($GET(^DGEN(27.11,DGENRIEN,0)),"^",3)
+14 ;
GET(DGENRIEN,DGENR) ;
+1 ;Description: Used to obtain a record from the Patient Enrollment file
+2 ; into the local DGENR array.
+3 ;Input :
+4 ; DGENRIEN - this is the internal entry number of a PATIENT ENROLLMENT record
+5 ;Output:
+6 ; Function Value - returns 1 on success, 0 on failure.
+7 ; DGENR - this is the name of a local array, it should be passed by
+8 ; reference. If the function is successful this array will
+9 ; contain the enrollment.
+10 ;
+11 ; subscript field name
+12 ; "APP" Enrollment Applicaiton Date
+13 ; "DATE" Enrollment Date
+14 ; "END" Enrollment End Date
+15 ; "DFN" Patient IEN
+16 ; "SOURCE" Enrollment Source
+17 ; "STATUS" Enrollment Status
+18 ; "REASON" Reason Canceled/Declined
+19 ; "REMARKS" Canceled/Declined Remarks
+20 ; "FACREC" Facility Received
+21 ; "PRIORITY" Enrollment Priority
+22 ; "SUBGRP" Enrollment Sub-Group
+23 ; "EFFDATE" Effective Date
+24 ; "PRIORREC" Prior Enrollment Record
+25 ; "ELIG","CODE" Primary Eligibility Code
+26 ; "ELIG","CODE",<code ien> Eligibility Codes
+27 ; "ELIG","SC" Service Connected
+28 ; "ELIG","SCPER" Service Connected Percentage
+29 ; "ELIG","POW" POW Status Indicated
+30 ; "ELIG","A&A" Receiving A&A Benefits
+31 ; "ELIG","HB" Receiving Housebound Benefits
+32 ; "ELIG","VAPEN" Receiving a VA Pension
+33 ; "ELIG","VACKAMT" Total Annual VA Check Amount
+34 ; "ELIG","DISRET" Military Disability Retirement
+35 ; "ELIG","DISLOD" Discharged Due to Disability
+36 ; "ELIG","MEDICAID" Medicaid
+37 ; "ELIG","AO" Exposed to Agent Orange
+38 ; "ELIG","AOEXPLOC" Agent Orange Exposure Location
+39 ; "ELIG","IR" Radiation Exposure Indicated
+40 ; "ELIG","RADEXPM" Radiation Exposure Method
+41 ; "ELIG","EC" SW Asia Cond - was Env Con, DG*5.3*688
+42 ; "ELIG","MTSTA" Means Test Status
+43 ; "ELIG","VCD" Veteran Catastrophically Disabled?
+44 ; "ELIG","PH" Purple Heart Indicated?
+45 ; "ELIG","UNEMPLOY" Unemployable
+46 ; "ELIG","CVELEDT" Combat Veteran End Date
+47 ; "ELIG","SHAD" SHAD Indicated
+48 ; "DATETIME" Date/Time Entered
+49 ; "USER" Entered By
+50 ;
+51 NEW SUB,NODE
+52 IF '$GET(DGENRIEN)
QUIT 0
+53 IF '$DATA(^DGEN(27.11,DGENRIEN,0))
QUIT 0
+54 KILL DGENR
+55 SET DGENR=""
+56 SET NODE=$GET(^DGEN(27.11,DGENRIEN,0))
+57 SET DGENR("APP")=$PIECE(NODE,"^")
+58 SET DGENR("DATE")=$PIECE(NODE,"^",10)
+59 SET DGENR("END")=$PIECE(NODE,"^",11)
+60 SET DGENR("DFN")=$PIECE(NODE,"^",2)
+61 SET DGENR("SOURCE")=$PIECE(NODE,"^",3)
+62 SET DGENR("STATUS")=$PIECE(NODE,"^",4)
+63 SET DGENR("REASON")=$PIECE(NODE,"^",5)
+64 SET DGENR("FACREC")=$PIECE(NODE,"^",6)
+65 SET DGENR("PRIORITY")=$PIECE(NODE,"^",7)
+66 SET DGENR("EFFDATE")=$PIECE(NODE,"^",8)
+67 SET DGENR("PRIORREC")=$PIECE(NODE,"^",9)
+68 ;Phase II Get enrollment sub-grp (SRS 6.4)
+69 SET DGENR("SUBGRP")=$PIECE(NODE,"^",12)
+70 SET NODE=$GET(^DGEN(27.11,DGENRIEN,"R"))
+71 SET DGENR("REMARKS")=$PIECE(NODE,"^")
+72 SET NODE=$GET(^DGEN(27.11,DGENRIEN,"E"))
+73 SET DGENR("ELIG","CODE")=$PIECE(NODE,"^")
+74 SET DGENR("ELIG","SC")=$PIECE(NODE,"^",2)
+75 SET DGENR("ELIG","SCPER")=$PIECE(NODE,"^",3)
+76 SET DGENR("ELIG","POW")=$PIECE(NODE,"^",4)
+77 SET DGENR("ELIG","A&A")=$PIECE(NODE,"^",5)
+78 SET DGENR("ELIG","HB")=$PIECE(NODE,"^",6)
+79 SET DGENR("ELIG","VAPEN")=$PIECE(NODE,"^",7)
+80 SET DGENR("ELIG","VACKAMT")=$PIECE(NODE,"^",8)
+81 SET DGENR("ELIG","DISRET")=$PIECE(NODE,"^",9)
+82 ;added with DG*5.3*672
SET DGENR("ELIG","DISLOD")=$PIECE(NODE,"^",20)
+83 SET DGENR("ELIG","MEDICAID")=$PIECE(NODE,"^",10)
+84 SET DGENR("ELIG","AO")=$PIECE(NODE,"^",11)
+85 ;added with DG*5.3*688
SET DGENR("ELIG","AOEXPLOC")=$PIECE(NODE,"^",22)
+86 SET DGENR("ELIG","IR")=$PIECE(NODE,"^",12)
+87 SET DGENR("ELIG","EC")=$PIECE(NODE,"^",13)
+88 SET DGENR("ELIG","MTSTA")=$PIECE(NODE,"^",14)
+89 SET DGENR("ELIG","VCD")=$PIECE(NODE,"^",15)
+90 SET DGENR("ELIG","PH")=$PIECE(NODE,"^",16)
+91 SET DGENR("ELIG","UNEMPLOY")=$PIECE(NODE,"^",17)
+92 SET DGENR("ELIG","CVELEDT")=$PIECE(NODE,"^",18)
+93 SET DGENR("ELIG","SHAD")=$PIECE(NODE,"^",19)
+94 SET DGENR("ELIG","RADEXPM")=$PIECE(NODE,"^",21)
+95 ;S DGENCDZZ=1 ; for CD Testing (disabled).
+96 SET NODE=$GET(^DGEN(27.11,DGENRIEN,"U"))
+97 SET DGENR("DATETIME")=$PIECE(NODE,"^")
+98 SET DGENR("USER")=$PIECE(NODE,"^",2)
+99 QUIT 1
+100 ;
