source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMBULK1.m@ 861

IVMBULK1 ;ALB/KCL - IVM/ENROLLMENT Extract Con't ; 18-AUG-1997

 ;;2.0;INCOME VERIFICATION MATCH;**9,11,15**; 21-OCT-94

 ;

 ;

GOGO ; --

 ; Description: This entry point will be the main driver for enrollment data extract.

 ;

 ;  Input:

 ;    IVMCONST - as local array containing extract input parameters

 ;               (constants), pass by reference

 ;    IVMARRY1 - as local array containing extract input parameters

 ;               (variable), pass by reference

 ;

 ; Output: None

 ;

 ; Perform enrollment data extract

 D BULK(.IVMCONST,.IVMARRY1)

 ;

 ; Send extract notification message

 D DOMAIL

 ;

 ; If enrollment events not on, turn on enrollment events

 I '$$ON^IVMUPAR1() D SETON^IVMUPAR1

 ;

 Q

 ;

 ;

BULK(IVMCONST,IVMARRY1) ; --

 ; Description: This entry point will perform the enrollment data extract.

 ;

 ;  Input:

 ;    IVMCONST - as local array containing extract input parameters

 ;               (constants), pass by reference

 ;    IVMARRY1 - as local array containing extract input parameters

 ;               (variable), pass by reference

 ;

 ; Output: None

 ;

 ; initilize varibles

 N DFN,POP,Z

 K IVMQUERY("LTD"),IVMQUERY("OVIS")

 D INIT^IVMUFNC  ; HL7 vars

 S (IVMARRY1("ERROR"),IVMARRY1("TERM"))=""

 S IVMARRY1("HOST")=$S(IVMARRY1("HOST")'="":IVMARRY1("HOST"),1:IVMCONST("HOST"))

 S IVMARRY1("PROC")=$G(IVMARRY1("PROC")),IVMARRY1("EXTRACT")=$G(IVMARRY1("EXTRACT"))  ; extract statistic counters

 S IVMARRY1("START")=$$NOW^XLFDT  ; current date/time job started

 S IVMARRY1("TASK")=$G(ZTSK)

 ;

 ; store processing info

 I $$STORE^IVMBULK2(.IVMARRY1)

 ;

 ; open host file, if error quit

 D OPEN^%ZISH("FILE1",IVMARRY1("DIR"),IVMARRY1("HOST")_"_"_(1+(IVMARRY1("EXTRACT")\IVMCONST("MSGMAX"))),"A")

 I POP S IVMARRY1("ERROR")="Could not create host file in specified directory." G BULKQ

 ;

 ; loop through patients in Patient (#2) file

 S DFN=+IVMARRY1("LASTPAT")

 F  S DFN=$O(^DPT(DFN)) Q:'DFN  D  Q:IVMARRY1("ERROR")'=""

 .;

 .; - # of patients processed/checked

 .S IVMARRY1("PROC")=IVMARRY1("PROC")+1

 .;

 .; - quit if patient does not pass selection criteria

 .Q:'$$CRITERIA(DFN,IVMCONST("BEGDT"),DT)

 .;

 .; - kill ^TMP global containing previous HL7 msg

 .K ^TMP("HLS",$J,HLSDT)

 .;

 .; - build HL7 full data transmission msg for patient

 .D BUILD^IVMPTRN8(DFN,$$LD^IVMUFNC4(DFN),0,.IVMQUERY)

 .;

 .; - write HL7 full data transmission message to host file

 .D HOST(HLSDT)

 .;

 .; - # of patients extracted

 .S IVMARRY1("EXTRACT")=IVMARRY1("EXTRACT")+1

 .;

 .; - check if host file has reached max size limit

 .I IVMARRY1("EXTRACT")#IVMCONST("MSGMAX")=0 D  Q:IVMARRY1("ERROR")'=""

 ..;

 ..; -- close host file, max limit reached

 ..D CLOSE^%ZISH("FILE1")

 ..;

 ..; -- open next host file

 ..D OPEN^%ZISH("FILE1",IVMARRY1("DIR"),IVMARRY1("HOST")_"_"_(1+(IVMARRY1("EXTRACT")\IVMCONST("MSGMAX"))),"A")

 ..I POP S IVMARRY1("ERROR")="Could not open host file." Q

 .;

 .; - for every 100 patients processed, check if task stopped

 .I IVMARRY1("PROC")#100=0 D

 ..; -- check if task has been stopped

 ..I $$S^%ZTLOAD S IVMARRY1("ERROR")="Queued job stopped prior to completion.",IVMARRY1("TERM")=1,IVMARRY1("LASTPAT")=DFN

 ..; -- update IVM EXTRACT MANAGEMENT file

 ..I $$STORE^IVMBULK2(.IVMARRY1)

 ;

 ;Close the last treatment date search and the outpt visit queries

 F Z="LTD","OVIS" I $G(IVMQUERY(Z)) D CLOSE^SDQ(IVMQUERY(Z)) K IVMQUERY(Z)

 ; close host file

 D CLOSE^%ZISH("FILE1")

 ;

 ;

BULKQ ; set up final extract statistics

 I $G(DFN)'>0 S IVMARRY1("LASTPAT")=""

 S IVMARRY1("STOP")=$$NOW^XLFDT  ; current date/time job stopped

 S IVMARRY1("FILES")=(1+(IVMARRY1("EXTRACT")\IVMCONST("MSGMAX")))  ; # of host files

 ; 

 ; store processing info for extract in IVM Extract Management file

 I $$STORE^IVMBULK2(.IVMARRY1)

 ;

 ; unlock IVM EXTRACT MANAGEMENT file

 D UNLOCK^IVMBULK2(1)

 ;

 ; kill hl7 temp array

 K ^TMP("HLS",$J,HLSDT)

 ;

 ; Cleanup HL7/IVM vars (as defined by call to INIT^IVMUFNC)

 D CLEAN^IVMUFNC

 ;

 Q

 ;

 ;

CRITERIA(DFN,IVMDT1,IVMDT2) ; --

 ; Description: This function will determine if the patient meets the enrollment initial data extract selection criteria for a specific date range.

 ;

 ;  Input:

 ;       DFN - pointer to patient in Patient (#2) file

 ;    IVMDT1 - as start date to use when looking for episodes of care

 ;    IVMDT2 - as end date to use when looking for episodes of care

 ;

 ; Output:

 ;   Function Value - Does patient meet the selection criteria?

 ;                    Return 1 if successful, otherwise 0

 ;

 N IVMCRIT,IVMCUREN

 S IVMCRIT=0

 ;

 ; get enrollment status from patient's current enrollment

 S IVMCUREN=$$STATUS^DGENA(DFN),IVMCUREN=$G(IVMCUREN)

 ; is status unverified, verified, or pending 

 I IVMCUREN,(IVMCUREN=1!(IVMCUREN=2)!(IVMCUREN=9)) S IVMCRIT=1 G CRITQ

 ;

 ; if patient is not a veteran, exit

 I '$$VET^DGENPTA(DFN) G CRITQ

 ;

 ; is veteran a current inpatient?

 I $$CURINPAT^DGENPTA(DFN) S IVMCRIT=1 G CRITQ

 ;

 ; was veteran an inpatient?

 I $$INPAT^DGENPTA(DFN,IVMDT1,IVMDT2) S IVMCRIT=1 G CRITQ

 ;

 ; does veteran have a checked-out encounter (outpatient)?

 I $$OUTPAT^DGENPTA(DFN,IVMDT1,IVMDT2) S IVMCRIT=1 G CRITQ

 ;

CRITQ Q IVMCRIT

 ;

 ;

HOST(HLSDT) ; --

 ; Description: Take HL7 message contained in temporary array and write to host file.

 ;

 ;  Input:

 ;                      IO - name of opened host file in the format to

 ;                           to use for the 'M' USE command

 ;    ^TMP("HLS",$J,HLSDT) - global array containing all segments of the

 ;                           HL7 message for a patient.  The HLSDT

 ;                           variable is a flag that indicates that data

 ;                           is to be stored in the ^TMP("HLS") global

 ;                           array.  The IVMCT variable is a sequential

 ;                           number starting at 0 and incremented by 1.

 ;

 ; Output: None

 ;

 N IVMSUB

 ;

 ; use host file

 U IO

 ;

 ; used to delineate begining of new HL7 message

 W "{",!

 ;

 ; write message segments to host file

 S IVMSUB="" F  S IVMSUB=$O(^TMP("HLS",$J,HLSDT,IVMSUB)) Q:IVMSUB'>0  D

 .W $G(^TMP("HLS",$J,HLSDT,IVMSUB)),!

 ;

 ; used to delineate end of HL7 message

 W "}",!

 ;

 Q

 ;

 ;

DOMAIL ; --

 ; Description: This function will generate a MailMan message contianing the results of the enrollment data extract.

 ;

 ;  Input: None

 ;

 ; Output: None

 ;

 K XMZ

 N DIFROM,IVMCON1,IVMMSG,IVMPRCNT,IVMSITE,XMTEXT,XMSUB,XMDUZ,XMY

 ;

 ; init mail variables

 S IVMSITE=$$SITE^VASITE

 S XMSUB="Enrollment Extract Results "_"("_$P(IVMSITE,"^",3)_")"

 S XMDUZ=.5,XMY(DUZ)="",XMY(.5)=""

 S XMTEXT="IVMMSG("

 ;

 ; if error creating message text, exit

 I '$$FINAL(.IVMMSG) G DOMAILQ

 ;

 ; get extract constants

 I $$GETCONST^IVMBULK2(.IVMCON1)

 ;

 ; HEC mail group

 I IVMARRY1("ERROR")']"" S XMY(IVMCON1("MAILGRP"))=""

 ;

 ; send msg

 D ^XMD

 ;

DOMAILQ Q

 ;

 ;

FINAL(IVMTXT) ; --

 ; Description: Places message text into local IVMTXT array.

 ;

 ;  Input: None

 ;

 ; Output:

 ;   Function Value - returns 1 if success, 0 if failure

 ;   IVMTXT - as local array containing mail message text,

 ;            pass by reference

 ;

 N SUCCESS,IVMSITE,IVMARRY2

 S SUCCESS=0

 ;

 ; if obtaining IVM Extract Management record unsuccessful, exit

 I '$$GET^IVMBULK2(.IVMARRY2) G FINALQ

 ;

 S IVMSITE=$$SITE^VASITE

 ;

 S IVMTXT(1)="    > > > > > > > > > >  ENROLLMENT DATA 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 job started:  "_$$FMTE^XLFDT(IVMARRY2("START"),"1P")

 S IVMTXT(7)="               Date/Time job stopped:  "_$$FMTE^XLFDT(IVMARRY2("STOP"),"1P")

 S IVMTXT(8)=""

 S IVMTXT(9)="            Total patients processed:  "_IVMARRY2("PROC")

 S IVMTXT(10)="            Total patients extracted:  "_IVMARRY2("EXTRACT")

 S IVMTXT(11)="                Percentage extracted:  "_$S($G(IVMARRY2("PROC")):$P(IVMARRY2("EXTRACT")/IVMARRY2("PROC")*100,".")_"%",1:"")

 S IVMTXT(12)=""

 S IVMTXT(13)="                 Host file directory:  "_IVMARRY2("DIR")

 S IVMTXT(14)="                      Host file name:  "_IVMARRY2("HOST")

 S IVMTXT(15)="                Number of host files:  "_IVMARRY2("FILES")

 ;

 ; if ERROR, set error into msg text

 I IVMARRY2("ERROR")]"" D

 .S IVMTXT(16)=""

 .S IVMTXT(17)="               * * * * E R R O R  E N C O U N T E R E D * * * *"

 .S IVMTXT(18)=""

 .S IVMTXT(19)="          Error Message:  "_IVMARRY2("ERROR")

 .S IVMTXT(20)="            Task Number:  "_IVMARRY2("TASK")

 ;

 S SUCCESS=1

 ;

FINALQ Q SUCCESS