IVM20P19 ;ALB/KCL - Post-Install Extract ; 1-SEP-1998
;;2.0;INCOME VERIFICATION MATCH;**19**; 21-OCT-94
;
;
POST ; Entry point for post-install, setup check points
N %
S %=$$NEWCP^XPDUTL("DFN","EN^IVM20P19",0)
Q
;
;
EN ; Description: This entry point will be the driver for the extract.
;
; Input: None
; Output: None
;
N IVMARRAY,IVMBEGDT,IVMENDDT
;
; init variables (start/end date for search)
S IVMBEGDT=2961001
S IVMENDDT=DT
;
; perform extract, display results during post-install
D BMES^XPDUTL(" Examining the PATIENT #2 file...")
D EXTRACT(IVMBEGDT,IVMENDDT,.IVMARRAY)
;
D MES^XPDUTL(" Total patients processed: "_IVMARRAY("PROC"))
D MES^XPDUTL(" Total patients extracted: "_IVMARRAY("EXTRACT"))
D MES^XPDUTL(" Percentage extracted: "_$S($G(IVMARRAY("PROC")):$P(IVMARRAY("EXTRACT")/IVMARRAY("PROC")*100,".")_"%",1:""))
D MES^XPDUTL("")
D MES^XPDUTL(" The "_IVMARRAY("EXTRACT")_" patients extracted will be included in the next daily")
D MES^XPDUTL(" transmission(s) to the Health Eligibility Center (HEC).")
;
; send extract results bulletin
D BMES^XPDUTL(" Sending extract results bulletin...")
D BULL(.IVMARRAY)
Q
;
;
;
; Input:
; BEGDT - as begin date for extract search
; ENDDT - as end date for extract search
;
; Output:
; IVMARRAY - as local array containing extract results, pass by reference
;
N DFN
;
; init varibles
K IVMARRAY S IVMARRAY=""
S IVMARRAY("START")=$$NOW^XLFDT ; current date/time started
S IVMARRAY("PROC")=0 ; count of patients processed
S IVMARRAY("EXTRACT")=0 ; count of patients extracted
S IVMARRAY("TOTAL")=$P($G(^DPT(0)),"^",4) ; total patients to check
S XPDIDTOT=IVMARRAY("TOTAL") ; total patients for status bar
S IVMARRAY("UPDATE%")=5 ; init % for status bar update
;
; retrieve checkpoint parameter value to init DFN, previous run
S DFN=+$$PARCP^XPDUTL("DFN")
;
; loop thru patients in PATIENT (#2) file
F S DFN=$O(^DPT(DFN)) Q:'DFN D
.;
.; - update checkpoint parameter DFN
.S %=$$UPCP^XPDUTL("DFN",DFN)
.;
.S IVMARRAY("PROC")=IVMARRAY("PROC")+1
.;
.; - update status bar during post-install if not queued
.I '$D(ZTQUEUED) D
..S IVMARRAY("COMP%")=IVMARRAY("PROC")*100/IVMARRAY("TOTAL") ; % complete
..I IVMARRAY("COMP%")>IVMARRAY("UPDATE%") D
...D UPDATE^XPDID(IVMARRAY("PROC"))
...S IVMARRAY("UPDATE%")=IVMARRAY("UPDATE%")+5 ; increase update %
.;
.; - quit if patient does not pass 1/98 bulk extract criteria
.Q:'$$CRITERIA^IVMBULK1(DFN,BEGDT,ENDDT)
.;
.; - quit if patient does not pass current selection criteria
.Q:'$$SELECT(DFN)
.;
.; - log patient for transmission in IVM PATIENT file
.N EVENTS
.S EVENTS("ENROLL")=1
.I $$LOG^IVMPLOG(DFN,$$YEAR^IVMPLOG(DFN),.EVENTS) S IVMARRAY("EXTRACT")=IVMARRAY("EXTRACT")+1
.;
;
S IVMARRAY("STOP")=$$NOW^XLFDT ; current date/time stopped
Q
;
;
SELECT(DFN) ; Description: This function will determine if the patient meets the following extract selection criteria:
;
; [Patient has SERVICE CONNECTED PERCENTAGE=0]
; OR
; [Patient has Other Entitled Eligibilities]
;
; Input:
; DFN - as ien of record in PATIENT (#2) file
;
; Output:
; Function Value - Return 1 if patient meets the selection criteria, otherwise 0 is returned
;
N SELECT S SELECT=0
;
; does the patient have an SC %=0?
I $$SCZERO(DFN) S SELECT=1 G SELECTQ
;
; does patient have other entitled eligibilities?
I $$OTHELIG(DFN) S SELECT=1
;
SELECTQ Q SELECT
;
;
SCZERO(DFN) ; Description: Used to determine if a patient has a SERVICE CONNECTED PERCENTAGE equal to zero.
;
; Input:
; DFN - as ien of record in PATIENT (#2) file
;
; Output:
; Function Value - Return 1 if patient has a SERVICE CONNECTED PERCENTAGE equal to zero, otherwise return 0
;
N SCZERO S SCZERO=0
;
I $G(DFN),$D(^DPT(DFN,0)) D
.I $P($G(^DPT(DFN,.3)),"^",2)=0 S SCZERO=1
;
Q SCZERO
;
;
OTHELIG(DFN) ; Description: Used to determine if a patient has OTHER ENTITLED ELIGIBILITIES.
;
; Input:
; DFN - as ien of record in PATIENT (#2) file
;
; Output:
; Function Value - return 1 if patient has other entitled eligibilities, otherwise return 0
;
N OTH,OTHELIG,PRIME
S (OTHELIG,OTH)=0
;
I $G(DFN),$D(^DPT(DFN,0)) S PRIME=+$G(^DPT(DFN,.36))
;
; if Primary Eligibility, check for Other Entitled Eligibilities
I $G(PRIME) D
.F S OTHELIG=$O(^DPT(DFN,"E",OTHELIG)) Q:'OTHELIG!(OTH=1) D
..I OTHELIG'=PRIME S OTH=1
;
Q OTH
;
;
BULL(IVMARRAY) ; Description: This function will generate a MailMan message contianing the extract results.
;
; Input:
; IVMARRAY - as local array containing extract results
;
; Output: None
;
K XMZ
N IVMTXT,IVMSITE,XMTEXT,XMSUB,XMDUZ,XMY
N DIFROM ; must new DIFROM when calling MailMan
;
; init variables
S IVMSITE=$$SITE^VASITE
S XMSUB="Patch IVM*2*19 Extract Results "_"("_$P(IVMSITE,"^",3)_")"
S XMDUZ=.5
S XMY(DUZ)="",XMY(.5)="",XMY("G.ENROLLMENT EXTRACT@IVM.DOMAIN.EXT")=""
S XMTEXT="IVMTXT("
;
S IVMTXT(1)=" > > > > Patch IVM*2*19 Extract Results < < < <"
S IVMTXT(2)=""
S IVMTXT(3)=" Facility Name: "_$P(IVMSITE,"^",2)
S IVMTXT(4)=" Station Number: "_$P(IVMSITE,"^",3)
S IVMTXT(5)=""
S IVMTXT(6)=" Date/Time extract started: "_$$FMTE^XLFDT(IVMARRAY("START"),"1P")
S IVMTXT(7)=" Date/Time extract stopped: "_$$FMTE^XLFDT(IVMARRAY("STOP"),"1P")
S IVMTXT(8)=""
S IVMTXT(9)=" Total patients processed: "_IVMARRAY("PROC")
S IVMTXT(10)=" Total patients extracted: "_IVMARRAY("EXTRACT")
S IVMTXT(11)=" Percentage extracted: "_$S($G(IVMARRAY("PROC")):$P(IVMARRAY("EXTRACT")/IVMARRAY("PROC")*100,".")_"%",1:"")
S IVMTXT(12)=""
S IVMTXT(13)=" The "_IVMARRAY("EXTRACT")_" patients extracted will be included in the next daily"
S IVMTXT(14)=" transmission(s) to the Health Eligibility Center (HEC)."
;
D ^XMD
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVM20P19 6181 printed Dec 13, 2024@02:00:42 Page 2
IVM20P19 ;ALB/KCL - Post-Install Extract ; 1-SEP-1998
+1 ;;2.0;INCOME VERIFICATION MATCH;**19**; 21-OCT-94
+2 ;
+3 ;
POST ; Entry point for post-install, setup check points
+1 NEW %
+2 SET %=$$NEWCP^XPDUTL("DFN","EN^IVM20P19",0)
+3 QUIT
+4 ;
+5 ;
EN ; Description: This entry point will be the driver for the extract.
+1 ;
+2 ; Input: None
+3 ; Output: None
+4 ;
+5 NEW IVMARRAY,IVMBEGDT,IVMENDDT
+6 ;
+7 ; init variables (start/end date for search)
+8 SET IVMBEGDT=2961001
+9 SET IVMENDDT=DT
+10 ;
+11 ; perform extract, display results during post-install
+12 DO BMES^XPDUTL(" Examining the PATIENT #2 file...")
+13 DO EXTRACT(IVMBEGDT,IVMENDDT,.IVMARRAY)
+14 ;
+15 DO MES^XPDUTL(" Total patients processed: "_IVMARRAY("PROC"))
+16 DO MES^XPDUTL(" Total patients extracted: "_IVMARRAY("EXTRACT"))
+17 DO MES^XPDUTL(" Percentage extracted: "_$SELECT($GET(IVMARRAY("PROC")):$PIECE(IVMARRAY("EXTRACT")/IVMARRAY("PROC")*100,".")_"%",1:""))
+18 DO MES^XPDUTL("")
+19 DO MES^XPDUTL(" The "_IVMARRAY("EXTRACT")_" patients extracted will be included in the next daily")
+20 DO MES^XPDUTL(" transmission(s) to the Health Eligibility Center (HEC).")
+21 ;
+22 ; send extract results bulletin
+23 DO BMES^XPDUTL(" Sending extract results bulletin...")
+24 DO BULL(.IVMARRAY)
+25 QUIT
+26 ;
+27 ;
+1 ;
+2 ; Input:
+3 ; BEGDT - as begin date for extract search
+4 ; ENDDT - as end date for extract search
+5 ;
+6 ; Output:
+7 ; IVMARRAY - as local array containing extract results, pass by reference
+8 ;
+9 NEW DFN
+10 ;
+11 ; init varibles
+12 KILL IVMARRAY
SET IVMARRAY=""
+13 ; current date/time started
SET IVMARRAY("START")=$$NOW^XLFDT
+14 ; count of patients processed
SET IVMARRAY("PROC")=0
+15 ; count of patients extracted
SET IVMARRAY("EXTRACT")=0
+16 ; total patients to check
SET IVMARRAY("TOTAL")=$PIECE($GET(^DPT(0)),"^",4)
+17 ; total patients for status bar
SET XPDIDTOT=IVMARRAY("TOTAL")
+18 ; init % for status bar update
SET IVMARRAY("UPDATE%")=5
+19 ;
+20 ; retrieve checkpoint parameter value to init DFN, previous run
+21 SET DFN=+$$PARCP^XPDUTL("DFN")
+22 ;
+23 ; loop thru patients in PATIENT (#2) file
+24 FOR
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
Begin DoDot:1
+25 ;
+26 ; - update checkpoint parameter DFN
+27 SET %=$$UPCP^XPDUTL("DFN",DFN)
+28 ;
+29 SET IVMARRAY("PROC")=IVMARRAY("PROC")+1
+30 ;
+31 ; - update status bar during post-install if not queued
+32 IF '$DATA(ZTQUEUED)
Begin DoDot:2
+33 ; % complete
SET IVMARRAY("COMP%")=IVMARRAY("PROC")*100/IVMARRAY("TOTAL")
+34 IF IVMARRAY("COMP%")>IVMARRAY("UPDATE%")
Begin DoDot:3
+35 DO UPDATE^XPDID(IVMARRAY("PROC"))
+36 ; increase update %
SET IVMARRAY("UPDATE%")=IVMARRAY("UPDATE%")+5
End DoDot:3
End DoDot:2
+37 ;
+38 ; - quit if patient does not pass 1/98 bulk extract criteria
+39 if '$$CRITERIA^IVMBULK1(DFN,BEGDT,ENDDT)
QUIT
+40 ;
+41 ; - quit if patient does not pass current selection criteria
+42 if '$$SELECT(DFN)
QUIT
+43 ;
+44 ; - log patient for transmission in IVM PATIENT file
+45 NEW EVENTS
+46 SET EVENTS("ENROLL")=1
+47 IF $$LOG^IVMPLOG(DFN,$$YEAR^IVMPLOG(DFN),.EVENTS)
SET IVMARRAY("EXTRACT")=IVMARRAY("EXTRACT")+1
+48 ;
End DoDot:1
+49 ;
+50 ; current date/time stopped
SET IVMARRAY("STOP")=$$NOW^XLFDT
+51 QUIT
+52 ;
+53 ;
SELECT(DFN) ; Description: This function will determine if the patient meets the following extract selection criteria:
+1 ;
+2 ; [Patient has SERVICE CONNECTED PERCENTAGE=0]
+3 ; OR
+4 ; [Patient has Other Entitled Eligibilities]
+5 ;
+6 ; Input:
+7 ; DFN - as ien of record in PATIENT (#2) file
+8 ;
+9 ; Output:
+10 ; Function Value - Return 1 if patient meets the selection criteria, otherwise 0 is returned
+11 ;
+12 NEW SELECT
SET SELECT=0
+13 ;
+14 ; does the patient have an SC %=0?
+15 IF $$SCZERO(DFN)
SET SELECT=1
GOTO SELECTQ
+16 ;
+17 ; does patient have other entitled eligibilities?
+18 IF $$OTHELIG(DFN)
SET SELECT=1
+19 ;
SELECTQ QUIT SELECT
+1 ;
+2 ;
SCZERO(DFN) ; Description: Used to determine if a patient has a SERVICE CONNECTED PERCENTAGE equal to zero.
+1 ;
+2 ; Input:
+3 ; DFN - as ien of record in PATIENT (#2) file
+4 ;
+5 ; Output:
+6 ; Function Value - Return 1 if patient has a SERVICE CONNECTED PERCENTAGE equal to zero, otherwise return 0
+7 ;
+8 NEW SCZERO
SET SCZERO=0
+9 ;
+10 IF $GET(DFN)
IF $DATA(^DPT(DFN,0))
Begin DoDot:1
+11 IF $PIECE($GET(^DPT(DFN,.3)),"^",2)=0
SET SCZERO=1
End DoDot:1
+12 ;
+13 QUIT SCZERO
+14 ;
+15 ;
OTHELIG(DFN) ; Description: Used to determine if a patient has OTHER ENTITLED ELIGIBILITIES.
+1 ;
+2 ; Input:
+3 ; DFN - as ien of record in PATIENT (#2) file
+4 ;
+5 ; Output:
+6 ; Function Value - return 1 if patient has other entitled eligibilities, otherwise return 0
+7 ;
+8 NEW OTH,OTHELIG,PRIME
+9 SET (OTHELIG,OTH)=0
+10 ;
+11 IF $GET(DFN)
IF $DATA(^DPT(DFN,0))
SET PRIME=+$GET(^DPT(DFN,.36))
+12 ;
+13 ; if Primary Eligibility, check for Other Entitled Eligibilities
+14 IF $GET(PRIME)
Begin DoDot:1
+15 FOR
SET OTHELIG=$ORDER(^DPT(DFN,"E",OTHELIG))
if 'OTHELIG!(OTH=1)
QUIT
Begin DoDot:2
+16 IF OTHELIG'=PRIME
SET OTH=1
End DoDot:2
End DoDot:1
+17 ;
+18 QUIT OTH
+19 ;
+20 ;
BULL(IVMARRAY) ; Description: This function will generate a MailMan message contianing the extract results.
+1 ;
+2 ; Input:
+3 ; IVMARRAY - as local array containing extract results
+4 ;
+5 ; Output: None
+6 ;
+7 KILL XMZ
+8 NEW IVMTXT,IVMSITE,XMTEXT,XMSUB,XMDUZ,XMY
+9 ; must new DIFROM when calling MailMan
NEW DIFROM
+10 ;
+11 ; init variables
+12 SET IVMSITE=$$SITE^VASITE
+13 SET XMSUB="Patch IVM*2*19 Extract Results "_"("_$PIECE(IVMSITE,"^",3)_")"
+14 SET XMDUZ=.5
+15 SET XMY(DUZ)=""
SET XMY(.5)=""
SET XMY("G.ENROLLMENT EXTRACT@IVM.DOMAIN.EXT")=""
+16 SET XMTEXT="IVMTXT("
+17 ;
+18 SET IVMTXT(1)=" > > > > Patch IVM*2*19 Extract Results < < < <"
+19 SET IVMTXT(2)=""
+20 SET IVMTXT(3)=" Facility Name: "_$PIECE(IVMSITE,"^",2)
+21 SET IVMTXT(4)=" Station Number: "_$PIECE(IVMSITE,"^",3)
+22 SET IVMTXT(5)=""
+23 SET IVMTXT(6)=" Date/Time extract started: "_$$FMTE^XLFDT(IVMARRAY("START"),"1P")
+24 SET IVMTXT(7)=" Date/Time extract stopped: "_$$FMTE^XLFDT(IVMARRAY("STOP"),"1P")
+25 SET IVMTXT(8)=""
+26 SET IVMTXT(9)=" Total patients processed: "_IVMARRAY("PROC")
+27 SET IVMTXT(10)=" Total patients extracted: "_IVMARRAY("EXTRACT")
+28 SET IVMTXT(11)=" Percentage extracted: "_$SELECT($GET(IVMARRAY("PROC")):$PIECE(IVMARRAY("EXTRACT")/IVMARRAY("PROC")*100,".")_"%",1:"")
+29 SET IVMTXT(12)=""
+30 SET IVMTXT(13)=" The "_IVMARRAY("EXTRACT")_" patients extracted will be included in the next daily"
+31 SET IVMTXT(14)=" transmission(s) to the Health Eligibility Center (HEC)."
+32 ;
+33 DO ^XMD
+34 QUIT
