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 Apr 09, 2024@21:00:29 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
