IVMBULK ;ALB/KCL - IVM/ENROLLMENT Extract ; 18-AUG-1997
;;2.0;INCOME VERIFICATION MATCH;**9**; 21-OCT-94
;
; * This extract will scan the PATIENT (#2) file for patients that
; meet the following enrollment extract selection criteria:
;
; [Patient has a current enrollment]
; AND
; [Enrollment status is 'Pending'
; OR
; Enrollment status is 'Unverified'
; OR
; Enrollment status is 'Verified']
;
; OR,
;
; [Patient is a Veteran]
; AND
; [Patient is a current inpatient
; OR
; Patient was an inpatient after 1/1/96
; OR
; Patient was an outpatient after 1/1/96]
;
;
; * An HL7 "Full Data Transmission" message (Z07) will be built
; for each patient selected. HL7 messages will be output to a
; selected host file.
;
; * A mail message will be generated upon completion of the initial
; data extract. This mail message will contian the results of
; the extract.
;
; * This job will be queued.
;
;
EN(IVMARRY1,IVMCONST) ; --
; Description: Entry point responsible for queuing off the enrollment extract job.
;
; Input: None
;
; Output:
; IVMARRY1 - as array containing required input parameters for enrollment extract job, pass by reference
; IVMCONST - as array containing enrollment extract constants, pass by reference
;
N ZTDESC,ZTIO,ZTRTN,ZTSAVE,QUIT
;
S QUIT=0
;
; lock IVM Extract Mangement file, otherwise exit
I '$$LOCK^IVMBULK2(1) D G ENQ
.W !,">>> This job has already been queued!"
;
; if environment check fails, exit
I '$$ENV() S QUIT=1 G ENQ
;
; get extract constants
I $$GETCONST^IVMBULK2(.IVMCONST)
;
; get IVM Extract Management record
I '$$GET^IVMBULK2(.IVMARRY1) D
.;
.; - if no IVM Extract Mgmt. record, init IVM Extract Mgmt. record
.I $$INIT^IVMBULK2(.IVMARRY1)
;
; don't want sites to unknowingly run extract again
I IVMARRY1("EXTRACT"),'IVMARRY1("LASTPAT") D G:QUIT ENQ
.W !,"> > > W A R N I N G",*7
.W !,?5,"The enrollment data extract has already run to completion!"
.W !,?5,"Do NOT run the extract again unless you have first deleted the"
.W !,?5,"host files that contain the prior extract!",!
.D INQUIRE^IVMBULK2("^IVM(301.63,",1)
.N DIR
.S DIR(0)="Y"
.S DIR("A")="Do you want to run the enrollment extract again"
.S DIR("B")="NO"
.D ^DIR
.I $D(DIRUT)!(Y'=1) D
..S QUIT=1
.E D
..D CLEAR(.IVMARRY1)
;
; write user info
D HDR1
;
; calculate extract size/time estimates
S IVMARRY1("PROJECT")=""
D EST(.IVMARRY1,.IVMCONST)
;
; if user time-out or abort, exit
I '$$PAUSE() S QUIT=1 G ENQ
;
; if directory not specified, exit
I IVMARRY1("DIR")="",('$$PATH^IVMBULK2(.IVMARRY1)) S QUIT=1 G ENQ
;
; queue enrollment extract job
S ZTSAVE("IVMARRY1(")="",ZTSAVE("IVMCONST(")=""
S ZTDESC="Enrollment Initial Data Extract",ZTRTN="GOGO^IVMBULK1",ZTIO=""
D ^%ZTLOAD,HOME^%ZIS
I $D(ZTSK) W !,"This job has been queued. The task number is "_ZTSK_"."
I '$D(ZTSK) W !,"Unable to queue this job." S QUIT=1
;
ENQ ;
; if job is not queued, unlock IVM EXTRACT MANAGEMENT file
I QUIT D UNLOCK^IVMBULK2(1)
Q
;
;
ENV() ; --
; Description: This function performs an environment check for the enrollment initial data extract job.
;
; Input: None
;
; Output:
; Function Value - Extract environment check successful?
; Return 1 if successful, otherwise 0
;
N IVMOK
S IVMOK=1
;
I '($D(DUZ)#2) W *7,!,"You must have a valid DUZ defined before running this routine!" S IVMOK=0
;
Q IVMOK
;
;
PAUSE() ; --
; Description: End-of-Page, Press return to continue or "^" to exit.
;
; Input: None
;
; Output: Function value - returns 1 if success, 0 otherwise
;
N DIR,DIRUT,DUOUT,SUCCESS,Y
S SUCCESS=0
;
S DIR(0)="E"
D ^DIR
I $D(DIRUT)!($D(DUOUT)) G PAUSEQ
;
S SUCCESS=1
;
PAUSEQ Q SUCCESS
;
;
EST(IVMARRY1,IVMCONST) ; --
; Description: Calculate extract size/time estimates.
;
; Input:
; IVMARRY1 - as array containing required input parameters for enrollment extract job, pass by reference
; IVMCONST - as array containing enrollment extract constants, pass by reference
;
; Output: None
;
N IVMTOTAL,X,X2,X3
;
; total patients in PATIENT file
S IVMTOTAL=$$TOTPAT(1)
;
; if extract complete, exit
I IVMTOTAL'>$G(IVMARRY1("PROC")) G ESTQ
;
; write estimate disclaimer
D HDR2(.IVMCONST)
;
S IVMTOTAL=IVMTOTAL-$G(IVMARRY1("PROC"))
S X=IVMTOTAL,X2=0,X3=10 D COMMA^%DTC
W !,?7,"Estimated number of patients to be processed: "_X
;W !,?7,"Estimated time of extract: "_$$TIMEST(IVMTOTAL,IVMCONST("PERCNT"),IVMCONST("AVG100"))
S X=$$TIMEST(IVMTOTAL,IVMCONST("PERCNT"),IVMCONST("AVG100"))
W !,?7,"Estimated time of extract: "_$P(X,"^",1)_" Hours "_$P(X,"^",2)_" Minutes"
S IVMARRY1("PROJECT")=$$FMADD^XLFDT($$NOW^XLFDT,0,$P(X,"^",1),$P(X,"^",2),0)
S X=($$SIZEST(IVMTOTAL,IVMCONST("PERCNT"),IVMCONST("SIZE"))\1),X2=0,X3=20 D COMMA^%DTC
W !,?7,"Estimated amount of disk space (bytes): "_X
W !
ESTQ Q
;
;
TOTPAT(ESTIMATE) ; --
; Description: This function counts the number of records in the PATIENT file.
;
; Input:
; ESTIMATE - (optional) if not passed, an actual patient count will be returned as the function value. If ESTIMATE=1, then an estimated number of patients in the Patient (#2) file will be returned as the function value.
;
; Output:
; Function Value - If ESTIMATE=1 the actual count of records in the patient file, otherwise the estimated count of records in the patient file.
;
N COUNT,DFN
S (COUNT,DFN)=0
;
; if flag, estimated count of records in Patient (#2) file (header node)
I $G(ESTIMATE) S COUNT=$P($G(^DPT(0)),"^",4)
;
ELSE D
.;
.; - loop through Patient (#2) file for actual count of records
.F S DFN=$O(^DPT(DFN)) Q:'DFN S COUNT=COUNT+1
;
Q COUNT
;
;
TIMEST(COUNT,PERCN,AVG100) ; --
; Description: This function will return a time estimate as to how long the initial data extract will run.
;
; Input:
; COUNT - number of patients in the PATIENT file
; PERCN - percentage of total patients that are expected to be extracted
; AVG100 - average time to add 100 patients to the extract in seconds
;
; Output:
; Function Value - If successful, returns the time estimate in the format HOURS^MINUTES. If function is not successful, the function returns NULL
;
N SECONDS,HOURS,MINUTES
;
I ($G(COUNT)'>0)!($G(PERCN)'>0)!($G(AVG100)'>0) Q ""
S SECONDS=(PERCN*AVG100*COUNT)/10000
S HOURS=SECONDS\3600
S SECONDS=SECONDS-(HOURS*3600)
S MINUTES=SECONDS\60
;
Q HOURS_"^"_MINUTES
;
;
SIZEST(COUNT,PERCN,SIZE) ;
; Description: This function will return a size estimate for the initial data extract.
;
; Input:
; COUNT - number of patients in the PATIENT file
; PERCN - percentage of total patients that are expected to be extracted
; SIZE - average size of single patient record in the extract in BYTES
; Output:
; Function Value - the estimated file size in BYTES
;
I (COUNT'>0)!(PERCN'>0)!(SIZE'>0) Q 0
Q (PERCN*SIZE*COUNT)/100
;
;
HDR1 ; --
; Description: Write extract user info.
;
; Input: None
; Output: None
;
W !!,"> > > E N R O L L M E N T D A T A E X T R A C T"
W !!,?5,"This job will loop through the Patient (#2) file to find patients"
W !,?5,"that meet the enrollment extract selection criteria.",!
W !,?5,"Due to the high integration with the Patient (#2) file, please"
W !,?5,"queue this job to run at non-peak hours.",!
Q
;
;
HDR2(IVMCONST) ; --
; Description: Write extract estimate disclaimer
;
; Input:
; IVMCONST() - an array containing extract constants, pass by reference
; IVMCONST("PERCNT") - % of patients expected to be extracted.
;
; Output: None
;
W !,?15," * * * * * P L E A S E N O T E * * * * *"
W !,?5,"The following time and space estimates are based on the approximate"
W !,?5,"number of patients in your database. Of those patients, it is assumed"
W !,?5,"that approximately "_IVMCONST("PERCNT")_"% will meet the requirements to be included in"
W !,?5,"the extract. Also, the time estimate provided does not account for"
W !,?5,"the speed of your system or the load on your system.",!
Q
;
CLEAR(IVMARRAY) ;
;Description: If the extract must be run again (the entire extract
;created from scratch, as opposed to restarted), the IVM EXTRACT
;MANAGMENT record needs to be cleared. This call will do that.
;
;Input: none
;Output:
; IVMARRAY - optional output variable, pass by reference,
; IVMARRAY() contains the IVM EXTRACT MANAGMENT record after
; being initialized.
;
N IVMCONST
;
I $$GETCONST^IVMBULK2(.IVMCONST),$$INIT^IVMBULK2(.IVMARRAY) D
.S IVMARRAY("HOST")=IVMCONST("HOST")
.I $$STORE^IVMBULK2(.IVMARRAY)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIVMBULK 9037 printed Apr 09, 2024@21:02:31 Page 2
IVMBULK ;ALB/KCL - IVM/ENROLLMENT Extract ; 18-AUG-1997
+1 ;;2.0;INCOME VERIFICATION MATCH;**9**; 21-OCT-94
+2 ;
+3 ; * This extract will scan the PATIENT (#2) file for patients that
+4 ; meet the following enrollment extract selection criteria:
+5 ;
+6 ; [Patient has a current enrollment]
+7 ; AND
+8 ; [Enrollment status is 'Pending'
+9 ; OR
+10 ; Enrollment status is 'Unverified'
+11 ; OR
+12 ; Enrollment status is 'Verified']
+13 ;
+14 ; OR,
+15 ;
+16 ; [Patient is a Veteran]
+17 ; AND
+18 ; [Patient is a current inpatient
+19 ; OR
+20 ; Patient was an inpatient after 1/1/96
+21 ; OR
+22 ; Patient was an outpatient after 1/1/96]
+23 ;
+24 ;
+25 ; * An HL7 "Full Data Transmission" message (Z07) will be built
+26 ; for each patient selected. HL7 messages will be output to a
+27 ; selected host file.
+28 ;
+29 ; * A mail message will be generated upon completion of the initial
+30 ; data extract. This mail message will contian the results of
+31 ; the extract.
+32 ;
+33 ; * This job will be queued.
+34 ;
+35 ;
EN(IVMARRY1,IVMCONST) ; --
+1 ; Description: Entry point responsible for queuing off the enrollment extract job.
+2 ;
+3 ; Input: None
+4 ;
+5 ; Output:
+6 ; IVMARRY1 - as array containing required input parameters for enrollment extract job, pass by reference
+7 ; IVMCONST - as array containing enrollment extract constants, pass by reference
+8 ;
+9 NEW ZTDESC,ZTIO,ZTRTN,ZTSAVE,QUIT
+10 ;
+11 SET QUIT=0
+12 ;
+13 ; lock IVM Extract Mangement file, otherwise exit
+14 IF '$$LOCK^IVMBULK2(1)
Begin DoDot:1
+15 WRITE !,">>> This job has already been queued!"
End DoDot:1
GOTO ENQ
+16 ;
+17 ; if environment check fails, exit
+18 IF '$$ENV()
SET QUIT=1
GOTO ENQ
+19 ;
+20 ; get extract constants
+21 IF $$GETCONST^IVMBULK2(.IVMCONST)
+22 ;
+23 ; get IVM Extract Management record
+24 IF '$$GET^IVMBULK2(.IVMARRY1)
Begin DoDot:1
+25 ;
+26 ; - if no IVM Extract Mgmt. record, init IVM Extract Mgmt. record
+27 IF $$INIT^IVMBULK2(.IVMARRY1)
End DoDot:1
+28 ;
+29 ; don't want sites to unknowingly run extract again
+30 IF IVMARRY1("EXTRACT")
IF 'IVMARRY1("LASTPAT")
Begin DoDot:1
+31 WRITE !,"> > > W A R N I N G",*7
+32 WRITE !,?5,"The enrollment data extract has already run to completion!"
+33 WRITE !,?5,"Do NOT run the extract again unless you have first deleted the"
+34 WRITE !,?5,"host files that contain the prior extract!",!
+35 DO INQUIRE^IVMBULK2("^IVM(301.63,",1)
+36 NEW DIR
+37 SET DIR(0)="Y"
+38 SET DIR("A")="Do you want to run the enrollment extract again"
+39 SET DIR("B")="NO"
+40 DO ^DIR
+41 IF $DATA(DIRUT)!(Y'=1)
Begin DoDot:2
+42 SET QUIT=1
End DoDot:2
+43 IF '$TEST
Begin DoDot:2
+44 DO CLEAR(.IVMARRY1)
End DoDot:2
End DoDot:1
if QUIT
GOTO ENQ
+45 ;
+46 ; write user info
+47 DO HDR1
+48 ;
+49 ; calculate extract size/time estimates
+50 SET IVMARRY1("PROJECT")=""
+51 DO EST(.IVMARRY1,.IVMCONST)
+52 ;
+53 ; if user time-out or abort, exit
+54 IF '$$PAUSE()
SET QUIT=1
GOTO ENQ
+55 ;
+56 ; if directory not specified, exit
+57 IF IVMARRY1("DIR")=""
IF ('$$PATH^IVMBULK2(.IVMARRY1))
SET QUIT=1
GOTO ENQ
+58 ;
+59 ; queue enrollment extract job
+60 SET ZTSAVE("IVMARRY1(")=""
SET ZTSAVE("IVMCONST(")=""
+61 SET ZTDESC="Enrollment Initial Data Extract"
SET ZTRTN="GOGO^IVMBULK1"
SET ZTIO=""
+62 DO ^%ZTLOAD
DO HOME^%ZIS
+63 IF $DATA(ZTSK)
WRITE !,"This job has been queued. The task number is "_ZTSK_"."
+64 IF '$DATA(ZTSK)
WRITE !,"Unable to queue this job."
SET QUIT=1
+65 ;
ENQ ;
+1 ; if job is not queued, unlock IVM EXTRACT MANAGEMENT file
+2 IF QUIT
DO UNLOCK^IVMBULK2(1)
+3 QUIT
+4 ;
+5 ;
ENV() ; --
+1 ; Description: This function performs an environment check for the enrollment initial data extract job.
+2 ;
+3 ; Input: None
+4 ;
+5 ; Output:
+6 ; Function Value - Extract environment check successful?
+7 ; Return 1 if successful, otherwise 0
+8 ;
+9 NEW IVMOK
+10 SET IVMOK=1
+11 ;
+12 IF '($DATA(DUZ)#2)
WRITE *7,!,"You must have a valid DUZ defined before running this routine!"
SET IVMOK=0
+13 ;
+14 QUIT IVMOK
+15 ;
+16 ;
PAUSE() ; --
+1 ; Description: End-of-Page, Press return to continue or "^" to exit.
+2 ;
+3 ; Input: None
+4 ;
+5 ; Output: Function value - returns 1 if success, 0 otherwise
+6 ;
+7 NEW DIR,DIRUT,DUOUT,SUCCESS,Y
+8 SET SUCCESS=0
+9 ;
+10 SET DIR(0)="E"
+11 DO ^DIR
+12 IF $DATA(DIRUT)!($DATA(DUOUT))
GOTO PAUSEQ
+13 ;
+14 SET SUCCESS=1
+15 ;
PAUSEQ QUIT SUCCESS
+1 ;
+2 ;
EST(IVMARRY1,IVMCONST) ; --
+1 ; Description: Calculate extract size/time estimates.
+2 ;
+3 ; Input:
+4 ; IVMARRY1 - as array containing required input parameters for enrollment extract job, pass by reference
+5 ; IVMCONST - as array containing enrollment extract constants, pass by reference
+6 ;
+7 ; Output: None
+8 ;
+9 NEW IVMTOTAL,X,X2,X3
+10 ;
+11 ; total patients in PATIENT file
+12 SET IVMTOTAL=$$TOTPAT(1)
+13 ;
+14 ; if extract complete, exit
+15 IF IVMTOTAL'>$GET(IVMARRY1("PROC"))
GOTO ESTQ
+16 ;
+17 ; write estimate disclaimer
+18 DO HDR2(.IVMCONST)
+19 ;
+20 SET IVMTOTAL=IVMTOTAL-$GET(IVMARRY1("PROC"))
+21 SET X=IVMTOTAL
SET X2=0
SET X3=10
DO COMMA^%DTC
+22 WRITE !,?7,"Estimated number of patients to be processed: "_X
+23 ;W !,?7,"Estimated time of extract: "_$$TIMEST(IVMTOTAL,IVMCONST("PERCNT"),IVMCONST("AVG100"))
+24 SET X=$$TIMEST(IVMTOTAL,IVMCONST("PERCNT"),IVMCONST("AVG100"))
+25 WRITE !,?7,"Estimated time of extract: "_$PIECE(X,"^",1)_" Hours "_$PIECE(X,"^",2)_" Minutes"
+26 SET IVMARRY1("PROJECT")=$$FMADD^XLFDT($$NOW^XLFDT,0,$PIECE(X,"^",1),$PIECE(X,"^",2),0)
+27 SET X=($$SIZEST(IVMTOTAL,IVMCONST("PERCNT"),IVMCONST("SIZE"))\1)
SET X2=0
SET X3=20
DO COMMA^%DTC
+28 WRITE !,?7,"Estimated amount of disk space (bytes): "_X
+29 WRITE !
ESTQ QUIT
+1 ;
+2 ;
TOTPAT(ESTIMATE) ; --
+1 ; Description: This function counts the number of records in the PATIENT file.
+2 ;
+3 ; Input:
+4 ; ESTIMATE - (optional) if not passed, an actual patient count will be returned as the function value. If ESTIMATE=1, then an estimated number of patients in the Patient (#2) file will be returned as the function value.
+5 ;
+6 ; Output:
+7 ; Function Value - If ESTIMATE=1 the actual count of records in the patient file, otherwise the estimated count of records in the patient file.
+8 ;
+9 NEW COUNT,DFN
+10 SET (COUNT,DFN)=0
+11 ;
+12 ; if flag, estimated count of records in Patient (#2) file (header node)
+13 IF $GET(ESTIMATE)
SET COUNT=$PIECE($GET(^DPT(0)),"^",4)
+14 ;
+15 IF '$TEST
Begin DoDot:1
+16 ;
+17 ; - loop through Patient (#2) file for actual count of records
+18 FOR
SET DFN=$ORDER(^DPT(DFN))
if 'DFN
QUIT
SET COUNT=COUNT+1
End DoDot:1
+19 ;
+20 QUIT COUNT
+21 ;
+22 ;
TIMEST(COUNT,PERCN,AVG100) ; --
+1 ; Description: This function will return a time estimate as to how long the initial data extract will run.
+2 ;
+3 ; Input:
+4 ; COUNT - number of patients in the PATIENT file
+5 ; PERCN - percentage of total patients that are expected to be extracted
+6 ; AVG100 - average time to add 100 patients to the extract in seconds
+7 ;
+8 ; Output:
+9 ; Function Value - If successful, returns the time estimate in the format HOURS^MINUTES. If function is not successful, the function returns NULL
+10 ;
+11 NEW SECONDS,HOURS,MINUTES
+12 ;
+13 IF ($GET(COUNT)'>0)!($GET(PERCN)'>0)!($GET(AVG100)'>0)
QUIT ""
+14 SET SECONDS=(PERCN*AVG100*COUNT)/10000
+15 SET HOURS=SECONDS\3600
+16 SET SECONDS=SECONDS-(HOURS*3600)
+17 SET MINUTES=SECONDS\60
+18 ;
+19 QUIT HOURS_"^"_MINUTES
+20 ;
+21 ;
SIZEST(COUNT,PERCN,SIZE) ;
+1 ; Description: This function will return a size estimate for the initial data extract.
+2 ;
+3 ; Input:
+4 ; COUNT - number of patients in the PATIENT file
+5 ; PERCN - percentage of total patients that are expected to be extracted
+6 ; SIZE - average size of single patient record in the extract in BYTES
+7 ; Output:
+8 ; Function Value - the estimated file size in BYTES
+9 ;
+10 IF (COUNT'>0)!(PERCN'>0)!(SIZE'>0)
QUIT 0
+11 QUIT (PERCN*SIZE*COUNT)/100
+12 ;
+13 ;
HDR1 ; --
+1 ; Description: Write extract user info.
+2 ;
+3 ; Input: None
+4 ; Output: None
+5 ;
+6 WRITE !!,"> > > E N R O L L M E N T D A T A E X T R A C T"
+7 WRITE !!,?5,"This job will loop through the Patient (#2) file to find patients"
+8 WRITE !,?5,"that meet the enrollment extract selection criteria.",!
+9 WRITE !,?5,"Due to the high integration with the Patient (#2) file, please"
+10 WRITE !,?5,"queue this job to run at non-peak hours.",!
+11 QUIT
+12 ;
+13 ;
HDR2(IVMCONST) ; --
+1 ; Description: Write extract estimate disclaimer
+2 ;
+3 ; Input:
+4 ; IVMCONST() - an array containing extract constants, pass by reference
+5 ; IVMCONST("PERCNT") - % of patients expected to be extracted.
+6 ;
+7 ; Output: None
+8 ;
+9 WRITE !,?15," * * * * * P L E A S E N O T E * * * * *"
+10 WRITE !,?5,"The following time and space estimates are based on the approximate"
+11 WRITE !,?5,"number of patients in your database. Of those patients, it is assumed"
+12 WRITE !,?5,"that approximately "_IVMCONST("PERCNT")_"% will meet the requirements to be included in"
+13 WRITE !,?5,"the extract. Also, the time estimate provided does not account for"
+14 WRITE !,?5,"the speed of your system or the load on your system.",!
+15 QUIT
+16 ;
CLEAR(IVMARRAY) ;
+1 ;Description: If the extract must be run again (the entire extract
+2 ;created from scratch, as opposed to restarted), the IVM EXTRACT
+3 ;MANAGMENT record needs to be cleared. This call will do that.
+4 ;
+5 ;Input: none
+6 ;Output:
+7 ; IVMARRAY - optional output variable, pass by reference,
+8 ; IVMARRAY() contains the IVM EXTRACT MANAGMENT record after
+9 ; being initialized.
+10 ;
+11 NEW IVMCONST
+12 ;
+13 IF $$GETCONST^IVMBULK2(.IVMCONST)
IF $$INIT^IVMBULK2(.IVMARRAY)
Begin DoDot:1
+14 SET IVMARRAY("HOST")=IVMCONST("HOST")
+15 IF $$STORE^IVMBULK2(.IVMARRAY)
End DoDot:1
+16 QUIT
