EAS25UEI ;ALB/CKN - GEOGRAPHIC MEANS TEST PHASE II ; 03-MAR-2003
;;1.0;ENROLLMENT APPLICATION SYSTEM;**25**;Mar 15, 2001
;This post install routine will check inpatient/outpatient encounters,
;future appointments and fee basis authorizations to determine
;User Enrollee status for each Veteran in PATIENT(#2) file.
;User Enrollee data will be stored in PATIENT file and transmitted
;to HEC via Z07 HL7 messages.
Q
EP ;Entry point
N DONE,TXT
;create bulletin message in install file.
S TXT(1)="The Post Install will now process through PATIENT (#2) file"
S TXT(2)="to determine User Enrollee status for each Veteran by checking"
S TXT(3)="inpatient/outpatient encounter for current fiscal year, any"
S TXT(4)="future appointments and any fee basis authorizations."
S TXT(5)=" "
D BMES^XPDUTL(.TXT)
;check for completion of checkpoint, quit if checkpoint completed.
;create new checkpoint if necessary
D CHECK Q:DONE
D QUETASK
Q
CHECK ;Initial checking
N STAT,TASKNUM
S DONE=0
I '$D(^XTMP("EAS*1*25")) Q
I $G(^XTMP("EAS*1*25","COMPLETED"))=1 D Q
. N MSG,XMDUZ,XMSUB,XMTEXT,XMY
. S (XMDUZ,XMSUB)="USER ENROLLEE INITIAL DETERMINATION PROCESS"
. S (XMY(.5),XMY(DUZ))="",XMTEXT="MSG("
. S MSG(1)="User Enrollee initial determination process was completed in previous run."
. S DONE=1 D ^XMD
. D BMES^XPDUTL(.MSG)
S TASKNUM=$G(^XTMP("EAS*1*25","TASK"))
I TASKNUM'="" D
. S STAT=$$ACTIVE(TASKNUM)
. I STAT>0 D
. . N MSG,XMDUZ,XMSUB,XMTEXT,XMY
. . S (XMDUZ,XMSUB)="USER ENROLLEE INITIAL DETERMINATION PROCESS"
. . S (XMY(.5),XMY(DUZ))="",XMTEXT="MSG("
. . S MSG(1)="Task: "_TASKNUM_" is currently running User Enrollee determination"
. . S MSG(2)="process. Duplicate process cannot be started."
. . S DONE=1 D ^XMD
. . D BMES^XPDUTL(.MSG)
Q
ACTIVE(TASK) ;Checks if task is running or not
; input -- The taskman ID
; output -- 1=The task is running
; 0=The task is not running
;
N ZTSK,STAT,Y
S STAT=0,ZTSK=+TASK
D STAT^%ZTLOAD
S Y=ZTSK(1)
I Y=0 S STAT=-1
I ",1,2,"[(","_Y_",") S STAT=1
I ",3,5,"[(","_Y_",") S STAT=0
Q STAT
;
QUETASK ;Queue the task
N TXT,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTDTH
S ZTRTN="EP1^EAS25UEI",ZTIO="",ZTDTH=$$NOW^XLFDT()
S ZTDESC="USER ENROLLEE INITIAL DETERMINATION PROCESS"
D ^%ZTLOAD S ^XTMP("EAS*1*25","TASK")=ZTSK
S TXT(1)="Task: "_ZTSK_" Queued."
D BMES^XPDUTL(.TXT)
Q
EP1 ;Entry point
N X,X1,X2,BDT,FDT,UEST,CNT,TXT,XIEN,TOT,ZTSTOP
S ZTSTOP=0
S XIEN=+$G(^XTMP("EAS*1*25","CURRENT IEN"))
S X1=DT,X2=60 D C^%DTC
S ^XTMP("EAS*1*25",0)=X_"^"_$$DT^XLFDT_"^EAS*1*25 GMT PHASE II-UE POST INSTALL"
;store start date
I '$D(^XTMP("EAS*1*25","DATE")) S $P(^XTMP("EAS*1*25","DATE"),"^",1)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
S TOT=$P($G(^XTMP("EAS*1*25",1)),"^"),CNT=$P($G(^XTMP("EAS*1*25",1)),"^",2)
;Loop through Patient file (#2)
F S XIEN=$O(^DPT(XIEN)) Q:+XIEN=0!(ZTSTOP) D
. S TOT=TOT+1 ;processed records counter
. S ^XTMP("EAS*1*25","CURRENT IEN")=XIEN
. I (TOT#1000=0),$$S^%ZTLOAD S ZTSTOP=1 ;Check for Stop request
. I $$DECEASED^EASMTUTL(XIEN) D Q ; Quit if Deceased
. . S ^XTMP("EAS*1*25",1)=TOT_"^"_CNT
. ;Remove current value to avoid any invalid data
. S CURUE=$P($G(^DPT(XIEN,.361)),"^",7,8)
. I $P(CURUE,"^")'=""!($P(CURUE,"^",2)'="") D
. . S (DATA(.3617),DATA(.3618))="@"
. . S UPD=$$UPD^DGENDBS(2,XIEN,.DATA)
. . K UPD,DATA,CURUE
. K TEMP
. D SCHED,ENC,FBENC ;Determine UE status
. S UEST=$O(TEMP("UE",9999999),-1) ;get last from all encounters
. I +$G(UEST) D
. . S CNT=CNT+1 ;User Enrollee counter
. . I $$UPDCHK^EASUER(XIEN,UEST) D FILE^EASUER(XIEN,UEST) ;file data
. S ^XTMP("EAS*1*25",1)=TOT_"^"_CNT
S $P(^XTMP("EAS*1*25","DATE"),"^",2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
I ZTSTOP D Q
. N MSG,XMDUZ,XMSUB,XMTEXT,XMY
. S (XMDUZ,XMSUB)="USER ENROLLEE INITIAL DETERMINATION PROCESS"
. S (XMY(.5),XMY(DUZ))="",XMTEXT="MSG("
. S MSG(1)="USER ENROLLEE INITIAL DETERMINATION PROCESS TASK: "_$G(^XTMP("EAS*1*25","TASK"))
. S MSG(2)=""
. S MSG(3)="User Enrollee initial determination process is requested to stop"
. S MSG(4)="by the user. Please restart the process by using the following"
. S MSG(5)="command at the programmer prompt:"
. S MSG(6)=""
. S MSG(7)="D EP^EAS25UEI"
. D ^XMD
D MAIL ;send mailman message to User
S ^XTMP("EAS*1*25","COMPLETED")=1
D BMES^XPDUTL("Post install process for initial User Enrollee determination is completed.")
Q
SCHED ;Check for future appointment
N XDT,NODE,SDRESULT
D GETAPPT^SDAMA201(XIEN,1,"R",DT,,.SDRESULT)
I SDRESULT>0 D
. S NODE=$O(^TMP($J,"SDAMA201","GETAPPT",""),-1)
. S XDT=$G(^TMP($J,"SDAMA201","GETAPPT",NODE,1))
. S XDT=$$FY^EASUER(XDT) I +$G(XDT) S TEMP("UE",XDT)="SCH"
Q
ENC ;Check for Inpatient/Outpatient encounters
N ENC,DFN,SDRESULT,DFN,VAIP
S ENC=$$EXOE^SDOEOE(XIEN,3021001,DT)
I ENC D Q
. S XDT=$$FY^EASUER(DT),TEMP("UE",XDT)="ENC"
I $O(^DPT(XIEN,"S",9999999))="" D ;Get appt between Oct1 - today
. D GETAPPT^SDAMA201(XIEN,1,"R",3021001,DT,.SDRESULT)
. I SDRESULT>0 D
. . S XDT=$$FY^EASUER(DT),TEMP("UE",XDT)="ENC"
I $G(SDRESULT)>0 Q
S DFN=XIEN D IN5^VADPT I +$G(VAIP(10)) D Q ;Check for Inpatient
. S XDT=$$FY^EASUER(DT),TEMP("UE",XDT)="ENC"
Q
FBENC ;Check for Fee basis encounters
N EDATE,TDATE
S TDATE=$$AUTH^FBGMT2(XIEN)
I TDATE=0!(TDATE<3021001) Q
S TDATE=$$FY^EASUER(TDATE) I +$G(TDATE) S TEMP("UE",TDATE)="FB"
Q
MAIL ;
N MSG,XMDUZ,XMSUB,XMTEXT,XMY,SITE,STATN,SITENM
S SITE=$$SITE^VASITE,STATN=$P($G(SITE),"^",3),SITENM=$P($G(SITE),"^",2)
S (XMDUZ,XMSUB)="GMTII - USER ENROLLEE INITIAL DETERMINATION PROCESS"
S (XMY(DUZ),XMY(.5))="",XMY("NAIK.CHINTAN@DOMAIN.EXT")=""
S XMTEXT="MSG("
S MSG(1)="User Enrollee initial determination process is completed successfully."
S MSG(1.5)="Task: "_$G(^XTMP("EAS*1*25","TASK"))
S MSG(2)=""
S MSG(3)="Site Station number: "_STATN
S MSG(4)="Site Name: "_SITENM
S MSG(5)=""
S MSG(6)="Process started at : "_$P($G(^XTMP("EAS*1*25","DATE")),"^",1)
S MSG(7)="Process completed at : "_$P($G(^XTMP("EAS*1*25","DATE")),"^",2)
S MSG(8)="Total Veterans processed : "_$P($G(^XTMP("EAS*1*25",1)),"^",1)
S MSG(9)="Total Veterans with UE status: "_$P($G(^XTMP("EAS*1*25",1)),"^",2)
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEAS25UEI 6356 printed Dec 13, 2024@01:53:37 Page 2
EAS25UEI ;ALB/CKN - GEOGRAPHIC MEANS TEST PHASE II ; 03-MAR-2003
+1 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**25**;Mar 15, 2001
+2 ;This post install routine will check inpatient/outpatient encounters,
+3 ;future appointments and fee basis authorizations to determine
+4 ;User Enrollee status for each Veteran in PATIENT(#2) file.
+5 ;User Enrollee data will be stored in PATIENT file and transmitted
+6 ;to HEC via Z07 HL7 messages.
+7 QUIT
EP ;Entry point
+1 NEW DONE,TXT
+2 ;create bulletin message in install file.
+3 SET TXT(1)="The Post Install will now process through PATIENT (#2) file"
+4 SET TXT(2)="to determine User Enrollee status for each Veteran by checking"
+5 SET TXT(3)="inpatient/outpatient encounter for current fiscal year, any"
+6 SET TXT(4)="future appointments and any fee basis authorizations."
+7 SET TXT(5)=" "
+8 DO BMES^XPDUTL(.TXT)
+9 ;check for completion of checkpoint, quit if checkpoint completed.
+10 ;create new checkpoint if necessary
+11 DO CHECK
if DONE
QUIT
+12 DO QUETASK
+13 QUIT
CHECK ;Initial checking
+1 NEW STAT,TASKNUM
+2 SET DONE=0
+3 IF '$DATA(^XTMP("EAS*1*25"))
QUIT
+4 IF $GET(^XTMP("EAS*1*25","COMPLETED"))=1
Begin DoDot:1
+5 NEW MSG,XMDUZ,XMSUB,XMTEXT,XMY
+6 SET (XMDUZ,XMSUB)="USER ENROLLEE INITIAL DETERMINATION PROCESS"
+7 SET (XMY(.5),XMY(DUZ))=""
SET XMTEXT="MSG("
+8 SET MSG(1)="User Enrollee initial determination process was completed in previous run."
+9 SET DONE=1
DO ^XMD
+10 DO BMES^XPDUTL(.MSG)
End DoDot:1
QUIT
+11 SET TASKNUM=$GET(^XTMP("EAS*1*25","TASK"))
+12 IF TASKNUM'=""
Begin DoDot:1
+13 SET STAT=$$ACTIVE(TASKNUM)
+14 IF STAT>0
Begin DoDot:2
+15 NEW MSG,XMDUZ,XMSUB,XMTEXT,XMY
+16 SET (XMDUZ,XMSUB)="USER ENROLLEE INITIAL DETERMINATION PROCESS"
+17 SET (XMY(.5),XMY(DUZ))=""
SET XMTEXT="MSG("
+18 SET MSG(1)="Task: "_TASKNUM_" is currently running User Enrollee determination"
+19 SET MSG(2)="process. Duplicate process cannot be started."
+20 SET DONE=1
DO ^XMD
+21 DO BMES^XPDUTL(.MSG)
End DoDot:2
End DoDot:1
+22 QUIT
ACTIVE(TASK) ;Checks if task is running or not
+1 ; input -- The taskman ID
+2 ; output -- 1=The task is running
+3 ; 0=The task is not running
+4 ;
+5 NEW ZTSK,STAT,Y
+6 SET STAT=0
SET ZTSK=+TASK
+7 DO STAT^%ZTLOAD
+8 SET Y=ZTSK(1)
+9 IF Y=0
SET STAT=-1
+10 IF ",1,2,"[(","_Y_",")
SET STAT=1
+11 IF ",3,5,"[(","_Y_",")
SET STAT=0
+12 QUIT STAT
+13 ;
QUETASK ;Queue the task
+1 NEW TXT,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTDTH
+2 SET ZTRTN="EP1^EAS25UEI"
SET ZTIO=""
SET ZTDTH=$$NOW^XLFDT()
+3 SET ZTDESC="USER ENROLLEE INITIAL DETERMINATION PROCESS"
+4 DO ^%ZTLOAD
SET ^XTMP("EAS*1*25","TASK")=ZTSK
+5 SET TXT(1)="Task: "_ZTSK_" Queued."
+6 DO BMES^XPDUTL(.TXT)
+7 QUIT
EP1 ;Entry point
+1 NEW X,X1,X2,BDT,FDT,UEST,CNT,TXT,XIEN,TOT,ZTSTOP
+2 SET ZTSTOP=0
+3 SET XIEN=+$GET(^XTMP("EAS*1*25","CURRENT IEN"))
+4 SET X1=DT
SET X2=60
DO C^%DTC
+5 SET ^XTMP("EAS*1*25",0)=X_"^"_$$DT^XLFDT_"^EAS*1*25 GMT PHASE II-UE POST INSTALL"
+6 ;store start date
+7 IF '$DATA(^XTMP("EAS*1*25","DATE"))
SET $PIECE(^XTMP("EAS*1*25","DATE"),"^",1)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
+8 SET TOT=$PIECE($GET(^XTMP("EAS*1*25",1)),"^")
SET CNT=$PIECE($GET(^XTMP("EAS*1*25",1)),"^",2)
+9 ;Loop through Patient file (#2)
+10 FOR
SET XIEN=$ORDER(^DPT(XIEN))
if +XIEN=0!(ZTSTOP)
QUIT
Begin DoDot:1
+11 ;processed records counter
SET TOT=TOT+1
+12 SET ^XTMP("EAS*1*25","CURRENT IEN")=XIEN
+13 ;Check for Stop request
IF (TOT#1000=0)
IF $$S^%ZTLOAD
SET ZTSTOP=1
+14 ; Quit if Deceased
IF $$DECEASED^EASMTUTL(XIEN)
Begin DoDot:2
+15 SET ^XTMP("EAS*1*25",1)=TOT_"^"_CNT
End DoDot:2
QUIT
+16 ;Remove current value to avoid any invalid data
+17 SET CURUE=$PIECE($GET(^DPT(XIEN,.361)),"^",7,8)
+18 IF $PIECE(CURUE,"^")'=""!($PIECE(CURUE,"^",2)'="")
Begin DoDot:2
+19 SET (DATA(.3617),DATA(.3618))="@"
+20 SET UPD=$$UPD^DGENDBS(2,XIEN,.DATA)
+21 KILL UPD,DATA,CURUE
End DoDot:2
+22 KILL TEMP
+23 ;Determine UE status
DO SCHED
DO ENC
DO FBENC
+24 ;get last from all encounters
SET UEST=$ORDER(TEMP("UE",9999999),-1)
+25 IF +$GET(UEST)
Begin DoDot:2
+26 ;User Enrollee counter
SET CNT=CNT+1
+27 ;file data
IF $$UPDCHK^EASUER(XIEN,UEST)
DO FILE^EASUER(XIEN,UEST)
End DoDot:2
+28 SET ^XTMP("EAS*1*25",1)=TOT_"^"_CNT
End DoDot:1
+29 SET $PIECE(^XTMP("EAS*1*25","DATE"),"^",2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
+30 IF ZTSTOP
Begin DoDot:1
+31 NEW MSG,XMDUZ,XMSUB,XMTEXT,XMY
+32 SET (XMDUZ,XMSUB)="USER ENROLLEE INITIAL DETERMINATION PROCESS"
+33 SET (XMY(.5),XMY(DUZ))=""
SET XMTEXT="MSG("
+34 SET MSG(1)="USER ENROLLEE INITIAL DETERMINATION PROCESS TASK: "_$GET(^XTMP("EAS*1*25","TASK"))
+35 SET MSG(2)=""
+36 SET MSG(3)="User Enrollee initial determination process is requested to stop"
+37 SET MSG(4)="by the user. Please restart the process by using the following"
+38 SET MSG(5)="command at the programmer prompt:"
+39 SET MSG(6)=""
+40 SET MSG(7)="D EP^EAS25UEI"
+41 DO ^XMD
End DoDot:1
QUIT
+42 ;send mailman message to User
DO MAIL
+43 SET ^XTMP("EAS*1*25","COMPLETED")=1
+44 DO BMES^XPDUTL("Post install process for initial User Enrollee determination is completed.")
+45 QUIT
SCHED ;Check for future appointment
+1 NEW XDT,NODE,SDRESULT
+2 DO GETAPPT^SDAMA201(XIEN,1,"R",DT,,.SDRESULT)
+3 IF SDRESULT>0
Begin DoDot:1
+4 SET NODE=$ORDER(^TMP($JOB,"SDAMA201","GETAPPT",""),-1)
+5 SET XDT=$GET(^TMP($JOB,"SDAMA201","GETAPPT",NODE,1))
+6 SET XDT=$$FY^EASUER(XDT)
IF +$GET(XDT)
SET TEMP("UE",XDT)="SCH"
End DoDot:1
+7 QUIT
ENC ;Check for Inpatient/Outpatient encounters
+1 NEW ENC,DFN,SDRESULT,DFN,VAIP
+2 SET ENC=$$EXOE^SDOEOE(XIEN,3021001,DT)
+3 IF ENC
Begin DoDot:1
+4 SET XDT=$$FY^EASUER(DT)
SET TEMP("UE",XDT)="ENC"
End DoDot:1
QUIT
+5 ;Get appt between Oct1 - today
IF $ORDER(^DPT(XIEN,"S",9999999))=""
Begin DoDot:1
+6 DO GETAPPT^SDAMA201(XIEN,1,"R",3021001,DT,.SDRESULT)
+7 IF SDRESULT>0
Begin DoDot:2
+8 SET XDT=$$FY^EASUER(DT)
SET TEMP("UE",XDT)="ENC"
End DoDot:2
End DoDot:1
+9 IF $GET(SDRESULT)>0
QUIT
+10 ;Check for Inpatient
SET DFN=XIEN
DO IN5^VADPT
IF +$GET(VAIP(10))
Begin DoDot:1
+11 SET XDT=$$FY^EASUER(DT)
SET TEMP("UE",XDT)="ENC"
End DoDot:1
QUIT
+12 QUIT
FBENC ;Check for Fee basis encounters
+1 NEW EDATE,TDATE
+2 SET TDATE=$$AUTH^FBGMT2(XIEN)
+3 IF TDATE=0!(TDATE<3021001)
QUIT
+4 SET TDATE=$$FY^EASUER(TDATE)
IF +$GET(TDATE)
SET TEMP("UE",TDATE)="FB"
+5 QUIT
MAIL ;
+1 NEW MSG,XMDUZ,XMSUB,XMTEXT,XMY,SITE,STATN,SITENM
+2 SET SITE=$$SITE^VASITE
SET STATN=$PIECE($GET(SITE),"^",3)
SET SITENM=$PIECE($GET(SITE),"^",2)
+3 SET (XMDUZ,XMSUB)="GMTII - USER ENROLLEE INITIAL DETERMINATION PROCESS"
+4 SET (XMY(DUZ),XMY(.5))=""
SET XMY("NAIK.CHINTAN@DOMAIN.EXT")=""
+5 SET XMTEXT="MSG("
+6 SET MSG(1)="User Enrollee initial determination process is completed successfully."
+7 SET MSG(1.5)="Task: "_$GET(^XTMP("EAS*1*25","TASK"))
+8 SET MSG(2)=""
+9 SET MSG(3)="Site Station number: "_STATN
+10 SET MSG(4)="Site Name: "_SITENM
+11 SET MSG(5)=""
+12 SET MSG(6)="Process started at : "_$PIECE($GET(^XTMP("EAS*1*25","DATE")),"^",1)
+13 SET MSG(7)="Process completed at : "_$PIECE($GET(^XTMP("EAS*1*25","DATE")),"^",2)
+14 SET MSG(8)="Total Veterans processed : "_$PIECE($GET(^XTMP("EAS*1*25",1)),"^",1)
+15 SET MSG(9)="Total Veterans with UE status: "_$PIECE($GET(^XTMP("EAS*1*25",1)),"^",2)
+16 DO ^XMD
+17 QUIT
