- EASUER ;ALB/CKN - GEOGRAPHIC MEANS TEST PHASE II ; 03-MAR-2003
- ;;1.0;ENROLLMENT APPLICATION SYSTEM;**25,37,50,55**;Mar 15, 2001
- ;This routine contains several APIs that will be called from
- ;different packages like Scheduling, PCE and Fee basis to notify
- ;Enrollment package whenever any inpatient/outpatient encounter occurs,
- ;or any appointment made or any changes made to fee basis authorization.
- Q
- SCHED ;This API will be called from SDAM APPOINTMENT EVENTS via EAS UE SCHED
- ;EVENT protocol whenever any changes made to veteran's appointment.
- ;Input variables used in this api:
- ; SDATA - piece 1 - ien of multiple entry of the
- ; APPOINTMENTS multiple of the
- ; HOSPITAL LOCATION file.
- ; piece 2 - ien of PATIENT file (DFN)
- ; piece 3 - internal Date/time of appt.
- ; piece 4 - ien of clinic in the HOSPITAL
- ; LOCATION file.
- ; SDAMEVT - ien pointing to an entry in the APPOINTMENT
- ; TRANSACTION file (#409.66).
- ;
- N DFN,APT,APTDT
- S DFN=$P($G(SDATA),"^",2) Q:DFN="" ;Veteran's IEN
- I $G(SDAMEVT)=1 D ;if new appointment is made
- . S APTDT=$P($G(SDATA),"^",3),APTDT=$$FY(APTDT)
- . ;check current User Enrollee data and update it if necessary.
- . I $$UPDCHK(DFN,APTDT) D FILE(DFN,APTDT)
- Q
- ENC ;This API will be called from PXK VISIT DATA EVENT via EAS UE PCE EVENT
- ;whenever any inpatient/outpatient encounter occurs.
- ;Input:
- ;^TMP("PXKCO",$J,VISIT,"V FILE STRING",V FILE RECORD,DDSUBSCRIPT,"AFTER/BEFORE")=DATA
- ;where: subscript piece 1 - string notation representing package "PXKCO"
- ; subscript piece 2 - Job number ($J)
- ; subscript piece 3 - ien of VISIT file
- ; subscript piece 4 - string representing the VISIT or V file
- ; data category
- ; subscript piece 5 - ien of the entry in the file represented in
- ; subscript #4
- ; subscript piece 6 - subscript or DD node on which the data is stored.
- ; subscript piece 7 - string designating whether or not the data
- ; is an "after" or "before" reflection of data.
- ;
- N VSIT,NODE,DFN,VDT
- I '$D(^TMP("PXKCO",$J)) Q
- S VSIT=$O(^TMP("PXKCO",$J,"")) Q:VSIT="" ;ien of VISIT file
- S NODE=$G(^AUPNVSIT(VSIT,0))
- ;get Veteran's IEN and encounter date
- S DFN=$P($G(NODE),"^",5),VDT=$P($G(NODE),"^",1)
- S VDT=$$FY(VDT)
- ;check current User Enrollee data and update if necessary
- I $$UPDCHK(DFN,VDT) D FILE(DFN,VDT)
- Q
- FBAUTH(FBDFN,FBTODT) ;This Enrollment api will be called from Fee basis
- ;applications at the time of any fee basis authorization changes.
- ;Input: FBDFN - Veteran's ien
- ; FBTODT - Latest date of authorization.
- ;
- N XDT
- S XDT=$$FY(FBTODT)
- I $$UPDCHK(FBDFN,XDT) D FILE(FBDFN,XDT)
- Q
- INP ;This Enrollment api will be called from DGPM MOVEMENT EVENT via
- ;EAS UE INP EVENT protocol whenever inpatient veteran is admitted,
- ;transfered,discharged or any movement.
- ;supported variables of this event:
- ; DFN - Pointer to patient in PATIENT file (#2)
- ; DGPMDA - Pointer to primary movement in PATIENT MOVEMENT file.
- ; DGPMP - Zero node of primary movement prior to add/edit/del
- ; DGPMA - Zero node of primary movement after add/edit/delete
- ;
- N XDT
- I '$G(DFN)!'$G(DGPMDA) Q
- S XDT=$P($G(^DGPM(DGPMDA,0)),"^") ;Date of movement
- S XDT=$$FY(XDT) I $$UPDCHK(DFN,XDT) D FILE(DFN,XDT)
- Q
- UESTAT(DFN) ;This api will be called at the time of Annual MT renewal
- ;process to check if veteran has UE status for current FY.
- N UESTAT,UESITE,UESTN,CURSTN,PRNT,CHILD,CIEN
- I '$G(DFN) Q 0 ;No DFN
- S UESTAT=$P($G(^DPT(DFN,.361)),"^",7)
- I UESTAT="" Q 0 ;Not User Enrollee
- I UESTAT<$$FY(DT) Q 0 ;Not User Enrollee for current FY
- S UESITE=$P($G(^DPT(DFN,.361)),"^",8) Q:+UESITE=0 0
- ; *** Modifications for patch 55 to handle VISN or HCS UE Sites
- S UESTN=$$STA^XUAF4(UESITE)
- S CURSTN=$P($$SITE^VASITE,"^",3)
- ;
- I UESTN']"" D
- . D CHILDREN^XUAF4("CHILD","`"_UESITE,"PARENT FACILITY")
- . S CIEN=0 F S CIEN=$O(CHILD("C",CIEN)) Q:'CIEN I CIEN=CURSTN S UESTN=$$STA^XUAF4(CIEN) Q
- . I UESTN']"" D
- . . D CHILDREN^XUAF4("CHILD","`"_UESITE,"VISN")
- . . S CIEN=0 F S CIEN=$O(CHILD("C",CIEN)) Q:'CIEN I CIEN=CURSTN S UESTN=$$STA^XUAF4(CIEN) Q
- ;
- S PRNT=$$PSITE(CURSTN),CURSTN=$$STA^XUAF4(PRNT)
- I UESTN'=CURSTN Q 2 ;Not same site
- Q 1
- UPDCHK(DFN,APTDT) ;This api will determine whether to update User Enrollee data.
- I '$G(DFN) Q 0 ;No DFN
- I $P($G(^DPT(DFN,"VET")),"^")="N" Q 0 ;Quit if Non veteran
- I APTDT<3030000 Q 0 ;Quit if APTDT is less than FY 2003
- N CURSTAT
- S CURSTAT=$P($G(^DPT(DFN,.361)),"^",7)
- I APTDT>CURSTAT Q 1
- Q 0
- FY(XDATE) ;Returns a fiscal year for the date
- N ENFY S ENFY=""
- I $G(XDATE)?7N.E S ENFY=$S($E(XDATE,4,5)<10:$E(XDATE,1,3),1:$E(XDATE,1,3)+1)
- Q ENFY_"0000"
- ;
- PSITE(STA) ;Get parent site IEN
- N PRNT,PRNTYP
- ;
- S PRNT=0
- ; First pass, get the parent facility, then get the facility type for the parent
- ; If the parent is a VAMC, then quit returning parent
- ; If the parent is either a VISN or HCS type, then return the current station, not the parent
- ;
- S PRNT=+$$PRNT^XUAF4(STA)
- I PRNT>0 D
- . S PRNTYP=$$GET1^DIQ(4,PRNT,13)
- . I PRNTYP="VAMC" Q
- . I "HCS,VISN"[PRNTYP S PRNT=STA Q
- E D
- . I $$GET1^DIQ(4,STA,13)="VAMC" S PRNT=STA Q
- . E S REVSTA=$E(STA,1,3),PRNT=+$$PRNT^XUAF4(REVSTA) D
- . . I $$GET1^DIQ(4,PRNT,13)="VAMC" Q
- . . S PRNT=+$O(^DIC(4,"D",REVSTA,""))
- Q PRNT
- ;
- CHKPRNT(PRNT) ; Check if parent is a VISN entity, removed with Patch 50
- Q 0
- ;
- FILE(XIEN,XDT) ;Update User Enrollee fields and queue Z07
- N DATA,FILEUPD,SITE,PRNT,EVENT,IYR
- S SITE=$$SITE^VASITE,SITE=$P($G(SITE),"^",3)
- S PRNT=$$PSITE(SITE) Q:'+$G(PRNT)
- S DATA(.3617)=XDT,DATA(.3618)=PRNT
- I '$$UPD^DGENDBS(2,.XIEN,.DATA) Q
- S IYR=$$INCYR(XIEN)
- S EVENT("ENROLL")=1 I $$LOG^IVMPLOG(XIEN,IYR,.EVENT)
- Q
- INCYR(XIEN) ;Get valid income year
- ;N INCYR,LMT,R3015,I,TEMP
- I $D(^IVM(301.5,"APT",XIEN)) D Q INCYR
- . S INCYR=$O(^IVM(301.5,"APT",XIEN,""),-1)
- F I=1,2,4 D
- . S LMT=$$LST^DGMTU(XIEN,,I)
- . I +$G(LMT) S TEMP($P(LMT,"^",2))=""
- I $D(TEMP) S LMT=$O(TEMP(""),-1),INCYR=($E(LMT,1,3)-1)_"0000" Q INCYR
- S INCYR=($E(DT,1,3)-1)_"0000"
- Q INCYR
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEASUER 6492 printed Jan 18, 2025@02:56:59 Page 2
- EASUER ;ALB/CKN - GEOGRAPHIC MEANS TEST PHASE II ; 03-MAR-2003
- +1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**25,37,50,55**;Mar 15, 2001
- +2 ;This routine contains several APIs that will be called from
- +3 ;different packages like Scheduling, PCE and Fee basis to notify
- +4 ;Enrollment package whenever any inpatient/outpatient encounter occurs,
- +5 ;or any appointment made or any changes made to fee basis authorization.
- +6 QUIT
- SCHED ;This API will be called from SDAM APPOINTMENT EVENTS via EAS UE SCHED
- +1 ;EVENT protocol whenever any changes made to veteran's appointment.
- +2 ;Input variables used in this api:
- +3 ; SDATA - piece 1 - ien of multiple entry of the
- +4 ; APPOINTMENTS multiple of the
- +5 ; HOSPITAL LOCATION file.
- +6 ; piece 2 - ien of PATIENT file (DFN)
- +7 ; piece 3 - internal Date/time of appt.
- +8 ; piece 4 - ien of clinic in the HOSPITAL
- +9 ; LOCATION file.
- +10 ; SDAMEVT - ien pointing to an entry in the APPOINTMENT
- +11 ; TRANSACTION file (#409.66).
- +12 ;
- +13 NEW DFN,APT,APTDT
- +14 ;Veteran's IEN
- SET DFN=$PIECE($GET(SDATA),"^",2)
- if DFN=""
- QUIT
- +15 ;if new appointment is made
- IF $GET(SDAMEVT)=1
- Begin DoDot:1
- +16 SET APTDT=$PIECE($GET(SDATA),"^",3)
- SET APTDT=$$FY(APTDT)
- +17 ;check current User Enrollee data and update it if necessary.
- +18 IF $$UPDCHK(DFN,APTDT)
- DO FILE(DFN,APTDT)
- End DoDot:1
- +19 QUIT
- ENC ;This API will be called from PXK VISIT DATA EVENT via EAS UE PCE EVENT
- +1 ;whenever any inpatient/outpatient encounter occurs.
- +2 ;Input:
- +3 ;^TMP("PXKCO",$J,VISIT,"V FILE STRING",V FILE RECORD,DDSUBSCRIPT,"AFTER/BEFORE")=DATA
- +4 ;where: subscript piece 1 - string notation representing package "PXKCO"
- +5 ; subscript piece 2 - Job number ($J)
- +6 ; subscript piece 3 - ien of VISIT file
- +7 ; subscript piece 4 - string representing the VISIT or V file
- +8 ; data category
- +9 ; subscript piece 5 - ien of the entry in the file represented in
- +10 ; subscript #4
- +11 ; subscript piece 6 - subscript or DD node on which the data is stored.
- +12 ; subscript piece 7 - string designating whether or not the data
- +13 ; is an "after" or "before" reflection of data.
- +14 ;
- +15 NEW VSIT,NODE,DFN,VDT
- +16 IF '$DATA(^TMP("PXKCO",$JOB))
- QUIT
- +17 ;ien of VISIT file
- SET VSIT=$ORDER(^TMP("PXKCO",$JOB,""))
- if VSIT=""
- QUIT
- +18 SET NODE=$GET(^AUPNVSIT(VSIT,0))
- +19 ;get Veteran's IEN and encounter date
- +20 SET DFN=$PIECE($GET(NODE),"^",5)
- SET VDT=$PIECE($GET(NODE),"^",1)
- +21 SET VDT=$$FY(VDT)
- +22 ;check current User Enrollee data and update if necessary
- +23 IF $$UPDCHK(DFN,VDT)
- DO FILE(DFN,VDT)
- +24 QUIT
- FBAUTH(FBDFN,FBTODT) ;This Enrollment api will be called from Fee basis
- +1 ;applications at the time of any fee basis authorization changes.
- +2 ;Input: FBDFN - Veteran's ien
- +3 ; FBTODT - Latest date of authorization.
- +4 ;
- +5 NEW XDT
- +6 SET XDT=$$FY(FBTODT)
- +7 IF $$UPDCHK(FBDFN,XDT)
- DO FILE(FBDFN,XDT)
- +8 QUIT
- INP ;This Enrollment api will be called from DGPM MOVEMENT EVENT via
- +1 ;EAS UE INP EVENT protocol whenever inpatient veteran is admitted,
- +2 ;transfered,discharged or any movement.
- +3 ;supported variables of this event:
- +4 ; DFN - Pointer to patient in PATIENT file (#2)
- +5 ; DGPMDA - Pointer to primary movement in PATIENT MOVEMENT file.
- +6 ; DGPMP - Zero node of primary movement prior to add/edit/del
- +7 ; DGPMA - Zero node of primary movement after add/edit/delete
- +8 ;
- +9 NEW XDT
- +10 IF '$GET(DFN)!'$GET(DGPMDA)
- QUIT
- +11 ;Date of movement
- SET XDT=$PIECE($GET(^DGPM(DGPMDA,0)),"^")
- +12 SET XDT=$$FY(XDT)
- IF $$UPDCHK(DFN,XDT)
- DO FILE(DFN,XDT)
- +13 QUIT
- UESTAT(DFN) ;This api will be called at the time of Annual MT renewal
- +1 ;process to check if veteran has UE status for current FY.
- +2 NEW UESTAT,UESITE,UESTN,CURSTN,PRNT,CHILD,CIEN
- +3 ;No DFN
- IF '$GET(DFN)
- QUIT 0
- +4 SET UESTAT=$PIECE($GET(^DPT(DFN,.361)),"^",7)
- +5 ;Not User Enrollee
- IF UESTAT=""
- QUIT 0
- +6 ;Not User Enrollee for current FY
- IF UESTAT<$$FY(DT)
- QUIT 0
- +7 SET UESITE=$PIECE($GET(^DPT(DFN,.361)),"^",8)
- if +UESITE=0
- QUIT 0
- +8 ; *** Modifications for patch 55 to handle VISN or HCS UE Sites
- +9 SET UESTN=$$STA^XUAF4(UESITE)
- +10 SET CURSTN=$PIECE($$SITE^VASITE,"^",3)
- +11 ;
- +12 IF UESTN']""
- Begin DoDot:1
- +13 DO CHILDREN^XUAF4("CHILD","`"_UESITE,"PARENT FACILITY")
- +14 SET CIEN=0
- FOR
- SET CIEN=$ORDER(CHILD("C",CIEN))
- if 'CIEN
- QUIT
- IF CIEN=CURSTN
- SET UESTN=$$STA^XUAF4(CIEN)
- QUIT
- +15 IF UESTN']""
- Begin DoDot:2
- +16 DO CHILDREN^XUAF4("CHILD","`"_UESITE,"VISN")
- +17 SET CIEN=0
- FOR
- SET CIEN=$ORDER(CHILD("C",CIEN))
- if 'CIEN
- QUIT
- IF CIEN=CURSTN
- SET UESTN=$$STA^XUAF4(CIEN)
- QUIT
- End DoDot:2
- End DoDot:1
- +18 ;
- +19 SET PRNT=$$PSITE(CURSTN)
- SET CURSTN=$$STA^XUAF4(PRNT)
- +20 ;Not same site
- IF UESTN'=CURSTN
- QUIT 2
- +21 QUIT 1
- UPDCHK(DFN,APTDT) ;This api will determine whether to update User Enrollee data.
- +1 ;No DFN
- IF '$GET(DFN)
- QUIT 0
- +2 ;Quit if Non veteran
- IF $PIECE($GET(^DPT(DFN,"VET")),"^")="N"
- QUIT 0
- +3 ;Quit if APTDT is less than FY 2003
- IF APTDT<3030000
- QUIT 0
- +4 NEW CURSTAT
- +5 SET CURSTAT=$PIECE($GET(^DPT(DFN,.361)),"^",7)
- +6 IF APTDT>CURSTAT
- QUIT 1
- +7 QUIT 0
- FY(XDATE) ;Returns a fiscal year for the date
- +1 NEW ENFY
- SET ENFY=""
- +2 IF $GET(XDATE)?7N.E
- SET ENFY=$SELECT($EXTRACT(XDATE,4,5)<10:$EXTRACT(XDATE,1,3),1:$EXTRACT(XDATE,1,3)+1)
- +3 QUIT ENFY_"0000"
- +4 ;
- PSITE(STA) ;Get parent site IEN
- +1 NEW PRNT,PRNTYP
- +2 ;
- +3 SET PRNT=0
- +4 ; First pass, get the parent facility, then get the facility type for the parent
- +5 ; If the parent is a VAMC, then quit returning parent
- +6 ; If the parent is either a VISN or HCS type, then return the current station, not the parent
- +7 ;
- +8 SET PRNT=+$$PRNT^XUAF4(STA)
- +9 IF PRNT>0
- Begin DoDot:1
- +10 SET PRNTYP=$$GET1^DIQ(4,PRNT,13)
- +11 IF PRNTYP="VAMC"
- QUIT
- +12 IF "HCS,VISN"[PRNTYP
- SET PRNT=STA
- QUIT
- End DoDot:1
- +13 IF '$TEST
- Begin DoDot:1
- +14 IF $$GET1^DIQ(4,STA,13)="VAMC"
- SET PRNT=STA
- QUIT
- +15 IF '$TEST
- SET REVSTA=$EXTRACT(STA,1,3)
- SET PRNT=+$$PRNT^XUAF4(REVSTA)
- Begin DoDot:2
- +16 IF $$GET1^DIQ(4,PRNT,13)="VAMC"
- QUIT
- +17 SET PRNT=+$ORDER(^DIC(4,"D",REVSTA,""))
- End DoDot:2
- End DoDot:1
- +18 QUIT PRNT
- +19 ;
- CHKPRNT(PRNT) ; Check if parent is a VISN entity, removed with Patch 50
- +1 QUIT 0
- +2 ;
- FILE(XIEN,XDT) ;Update User Enrollee fields and queue Z07
- +1 NEW DATA,FILEUPD,SITE,PRNT,EVENT,IYR
- +2 SET SITE=$$SITE^VASITE
- SET SITE=$PIECE($GET(SITE),"^",3)
- +3 SET PRNT=$$PSITE(SITE)
- if '+$GET(PRNT)
- QUIT
- +4 SET DATA(.3617)=XDT
- SET DATA(.3618)=PRNT
- +5 IF '$$UPD^DGENDBS(2,.XIEN,.DATA)
- QUIT
- +6 SET IYR=$$INCYR(XIEN)
- +7 SET EVENT("ENROLL")=1
- IF $$LOG^IVMPLOG(XIEN,IYR,.EVENT)
- +8 QUIT
- INCYR(XIEN) ;Get valid income year
- +1 ;N INCYR,LMT,R3015,I,TEMP
- +2 IF $DATA(^IVM(301.5,"APT",XIEN))
- Begin DoDot:1
- +3 SET INCYR=$ORDER(^IVM(301.5,"APT",XIEN,""),-1)
- End DoDot:1
- QUIT INCYR
- +4 FOR I=1,2,4
- Begin DoDot:1
- +5 SET LMT=$$LST^DGMTU(XIEN,,I)
- +6 IF +$GET(LMT)
- SET TEMP($PIECE(LMT,"^",2))=""
- End DoDot:1
- +7 IF $DATA(TEMP)
- SET LMT=$ORDER(TEMP(""),-1)
- SET INCYR=($EXTRACT(LMT,1,3)-1)_"0000"
- QUIT INCYR
- +8 SET INCYR=($EXTRACT(DT,1,3)-1)_"0000"
- +9 QUIT INCYR