| [613] | 1 | EASUER ;ALB/CKN - GEOGRAPHIC MEANS TEST PHASE II ; 03-MAR-2003
|
|---|
| 2 | ;;1.0;ENROLLMENT APPLICATION SYSTEM;**25,37,50,55**;Mar 15, 2001
|
|---|
| 3 | ;This routine contains several APIs that will be called from
|
|---|
| 4 | ;different packages like Scheduling, PCE and Fee basis to notify
|
|---|
| 5 | ;Enrollment package whenever any inpatient/outpatient encounter occurs,
|
|---|
| 6 | ;or any appointment made or any changes made to fee basis authorization.
|
|---|
| 7 | Q
|
|---|
| 8 | SCHED ;This API will be called from SDAM APPOINTMENT EVENTS via EAS UE SCHED
|
|---|
| 9 | ;EVENT protocol whenever any changes made to veteran's appointment.
|
|---|
| 10 | ;Input variables used in this api:
|
|---|
| 11 | ; SDATA - piece 1 - ien of multiple entry of the
|
|---|
| 12 | ; APPOINTMENTS multiple of the
|
|---|
| 13 | ; HOSPITAL LOCATION file.
|
|---|
| 14 | ; piece 2 - ien of PATIENT file (DFN)
|
|---|
| 15 | ; piece 3 - internal Date/time of appt.
|
|---|
| 16 | ; piece 4 - ien of clinic in the HOSPITAL
|
|---|
| 17 | ; LOCATION file.
|
|---|
| 18 | ; SDAMEVT - ien pointing to an entry in the APPOINTMENT
|
|---|
| 19 | ; TRANSACTION file (#409.66).
|
|---|
| 20 | ;
|
|---|
| 21 | N DFN,APT,APTDT
|
|---|
| 22 | S DFN=$P($G(SDATA),"^",2) Q:DFN="" ;Veteran's IEN
|
|---|
| 23 | I $G(SDAMEVT)=1 D ;if new appointment is made
|
|---|
| 24 | . S APTDT=$P($G(SDATA),"^",3),APTDT=$$FY(APTDT)
|
|---|
| 25 | . ;check current User Enrollee data and update it if necessary.
|
|---|
| 26 | . I $$UPDCHK(DFN,APTDT) D FILE(DFN,APTDT)
|
|---|
| 27 | Q
|
|---|
| 28 | ENC ;This API will be called from PXK VISIT DATA EVENT via EAS UE PCE EVENT
|
|---|
| 29 | ;whenever any inpatient/outpatient encounter occurs.
|
|---|
| 30 | ;Input:
|
|---|
| 31 | ;^TMP("PXKCO",$J,VISIT,"V FILE STRING",V FILE RECORD,DDSUBSCRIPT,"AFTER/BEFORE")=DATA
|
|---|
| 32 | ;where: subscript piece 1 - string notation representing package "PXKCO"
|
|---|
| 33 | ; subscript piece 2 - Job number ($J)
|
|---|
| 34 | ; subscript piece 3 - ien of VISIT file
|
|---|
| 35 | ; subscript piece 4 - string representing the VISIT or V file
|
|---|
| 36 | ; data category
|
|---|
| 37 | ; subscript piece 5 - ien of the entry in the file represented in
|
|---|
| 38 | ; subscript #4
|
|---|
| 39 | ; subscript piece 6 - subscript or DD node on which the data is stored.
|
|---|
| 40 | ; subscript piece 7 - string designating whether or not the data
|
|---|
| 41 | ; is an "after" or "before" reflection of data.
|
|---|
| 42 | ;
|
|---|
| 43 | N VSIT,NODE,DFN,VDT
|
|---|
| 44 | I '$D(^TMP("PXKCO",$J)) Q
|
|---|
| 45 | S VSIT=$O(^TMP("PXKCO",$J,"")) Q:VSIT="" ;ien of VISIT file
|
|---|
| 46 | S NODE=$G(^AUPNVSIT(VSIT,0))
|
|---|
| 47 | ;get Veteran's IEN and encounter date
|
|---|
| 48 | S DFN=$P($G(NODE),"^",5),VDT=$P($G(NODE),"^",1)
|
|---|
| 49 | S VDT=$$FY(VDT)
|
|---|
| 50 | ;check current User Enrollee data and update if necessary
|
|---|
| 51 | I $$UPDCHK(DFN,VDT) D FILE(DFN,VDT)
|
|---|
| 52 | Q
|
|---|
| 53 | FBAUTH(FBDFN,FBTODT) ;This Enrollment api will be called from Fee basis
|
|---|
| 54 | ;applications at the time of any fee basis authorization changes.
|
|---|
| 55 | ;Input: FBDFN - Veteran's ien
|
|---|
| 56 | ; FBTODT - Latest date of authorization.
|
|---|
| 57 | ;
|
|---|
| 58 | N XDT
|
|---|
| 59 | S XDT=$$FY(FBTODT)
|
|---|
| 60 | I $$UPDCHK(FBDFN,XDT) D FILE(FBDFN,XDT)
|
|---|
| 61 | Q
|
|---|
| 62 | INP ;This Enrollment api will be called from DGPM MOVEMENT EVENT via
|
|---|
| 63 | ;EAS UE INP EVENT protocol whenever inpatient veteran is admitted,
|
|---|
| 64 | ;transfered,discharged or any movement.
|
|---|
| 65 | ;supported variables of this event:
|
|---|
| 66 | ; DFN - Pointer to patient in PATIENT file (#2)
|
|---|
| 67 | ; DGPMDA - Pointer to primary movement in PATIENT MOVEMENT file.
|
|---|
| 68 | ; DGPMP - Zero node of primary movement prior to add/edit/del
|
|---|
| 69 | ; DGPMA - Zero node of primary movement after add/edit/delete
|
|---|
| 70 | ;
|
|---|
| 71 | N XDT
|
|---|
| 72 | I '$G(DFN)!'$G(DGPMDA) Q
|
|---|
| 73 | S XDT=$P($G(^DGPM(DGPMDA,0)),"^") ;Date of movement
|
|---|
| 74 | S XDT=$$FY(XDT) I $$UPDCHK(DFN,XDT) D FILE(DFN,XDT)
|
|---|
| 75 | Q
|
|---|
| 76 | UESTAT(DFN) ;This api will be called at the time of Annual MT renewal
|
|---|
| 77 | ;process to check if veteran has UE status for current FY.
|
|---|
| 78 | N UESTAT,UESITE,UESTN,CURSTN,PRNT,CHILD,CIEN
|
|---|
| 79 | I '$G(DFN) Q 0 ;No DFN
|
|---|
| 80 | S UESTAT=$P($G(^DPT(DFN,.361)),"^",7)
|
|---|
| 81 | I UESTAT="" Q 0 ;Not User Enrollee
|
|---|
| 82 | I UESTAT<$$FY(DT) Q 0 ;Not User Enrollee for current FY
|
|---|
| 83 | S UESITE=$P($G(^DPT(DFN,.361)),"^",8) Q:+UESITE=0 0
|
|---|
| 84 | ; *** Modifications for patch 55 to handle VISN or HCS UE Sites
|
|---|
| 85 | S UESTN=$$STA^XUAF4(UESITE)
|
|---|
| 86 | S CURSTN=$P($$SITE^VASITE,"^",3)
|
|---|
| 87 | ;
|
|---|
| 88 | I UESTN']"" D
|
|---|
| 89 | . D CHILDREN^XUAF4("CHILD","`"_UESITE,"PARENT FACILITY")
|
|---|
| 90 | . S CIEN=0 F S CIEN=$O(CHILD("C",CIEN)) Q:'CIEN I CIEN=CURSTN S UESTN=$$STA^XUAF4(CIEN) Q
|
|---|
| 91 | . I UESTN']"" D
|
|---|
| 92 | . . D CHILDREN^XUAF4("CHILD","`"_UESITE,"VISN")
|
|---|
| 93 | . . S CIEN=0 F S CIEN=$O(CHILD("C",CIEN)) Q:'CIEN I CIEN=CURSTN S UESTN=$$STA^XUAF4(CIEN) Q
|
|---|
| 94 | ;
|
|---|
| 95 | S PRNT=$$PSITE(CURSTN),CURSTN=$$STA^XUAF4(PRNT)
|
|---|
| 96 | I UESTN'=CURSTN Q 2 ;Not same site
|
|---|
| 97 | Q 1
|
|---|
| 98 | UPDCHK(DFN,APTDT) ;This api will determine whether to update User Enrollee data.
|
|---|
| 99 | I '$G(DFN) Q 0 ;No DFN
|
|---|
| 100 | I $P($G(^DPT(DFN,"VET")),"^")="N" Q 0 ;Quit if Non veteran
|
|---|
| 101 | I APTDT<3030000 Q 0 ;Quit if APTDT is less than FY 2003
|
|---|
| 102 | N CURSTAT
|
|---|
| 103 | S CURSTAT=$P($G(^DPT(DFN,.361)),"^",7)
|
|---|
| 104 | I APTDT>CURSTAT Q 1
|
|---|
| 105 | Q 0
|
|---|
| 106 | FY(XDATE) ;Returns a fiscal year for the date
|
|---|
| 107 | N ENFY S ENFY=""
|
|---|
| 108 | I $G(XDATE)?7N.E S ENFY=$S($E(XDATE,4,5)<10:$E(XDATE,1,3),1:$E(XDATE,1,3)+1)
|
|---|
| 109 | Q ENFY_"0000"
|
|---|
| 110 | ;
|
|---|
| 111 | PSITE(STA) ;Get parent site IEN
|
|---|
| 112 | N PRNT,PRNTYP
|
|---|
| 113 | ;
|
|---|
| 114 | S PRNT=0
|
|---|
| 115 | ; First pass, get the parent facility, then get the facility type for the parent
|
|---|
| 116 | ; If the parent is a VAMC, then quit returning parent
|
|---|
| 117 | ; If the parent is either a VISN or HCS type, then return the current station, not the parent
|
|---|
| 118 | ;
|
|---|
| 119 | S PRNT=+$$PRNT^XUAF4(STA)
|
|---|
| 120 | I PRNT>0 D
|
|---|
| 121 | . S PRNTYP=$$GET1^DIQ(4,PRNT,13)
|
|---|
| 122 | . I PRNTYP="VAMC" Q
|
|---|
| 123 | . I "HCS,VISN"[PRNTYP S PRNT=STA Q
|
|---|
| 124 | E D
|
|---|
| 125 | . I $$GET1^DIQ(4,STA,13)="VAMC" S PRNT=STA Q
|
|---|
| 126 | . E S REVSTA=$E(STA,1,3),PRNT=+$$PRNT^XUAF4(REVSTA) D
|
|---|
| 127 | . . I $$GET1^DIQ(4,PRNT,13)="VAMC" Q
|
|---|
| 128 | . . S PRNT=+$O(^DIC(4,"D",REVSTA,""))
|
|---|
| 129 | Q PRNT
|
|---|
| 130 | ;
|
|---|
| 131 | CHKPRNT(PRNT) ; Check if parent is a VISN entity, removed with Patch 50
|
|---|
| 132 | Q 0
|
|---|
| 133 | ;
|
|---|
| 134 | FILE(XIEN,XDT) ;Update User Enrollee fields and queue Z07
|
|---|
| 135 | N DATA,FILEUPD,SITE,PRNT,EVENT,IYR
|
|---|
| 136 | S SITE=$$SITE^VASITE,SITE=$P($G(SITE),"^",3)
|
|---|
| 137 | S PRNT=$$PSITE(SITE) Q:'+$G(PRNT)
|
|---|
| 138 | S DATA(.3617)=XDT,DATA(.3618)=PRNT
|
|---|
| 139 | I '$$UPD^DGENDBS(2,.XIEN,.DATA) Q
|
|---|
| 140 | S IYR=$$INCYR(XIEN)
|
|---|
| 141 | S EVENT("ENROLL")=1 I $$LOG^IVMPLOG(XIEN,IYR,.EVENT)
|
|---|
| 142 | Q
|
|---|
| 143 | INCYR(XIEN) ;Get valid income year
|
|---|
| 144 | ;N INCYR,LMT,R3015,I,TEMP
|
|---|
| 145 | I $D(^IVM(301.5,"APT",XIEN)) D Q INCYR
|
|---|
| 146 | . S INCYR=$O(^IVM(301.5,"APT",XIEN,""),-1)
|
|---|
| 147 | F I=1,2,4 D
|
|---|
| 148 | . S LMT=$$LST^DGMTU(XIEN,,I)
|
|---|
| 149 | . I +$G(LMT) S TEMP($P(LMT,"^",2))=""
|
|---|
| 150 | I $D(TEMP) S LMT=$O(TEMP(""),-1),INCYR=($E(LMT,1,3)-1)_"0000" Q INCYR
|
|---|
| 151 | S INCYR=($E(DT,1,3)-1)_"0000"
|
|---|
| 152 | Q INCYR
|
|---|
