Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IVMBULK1

IVMBULK1.m

Go to the documentation of this file. 
  1. IVMBULK1 ;ALB/KCL - IVM/ENROLLMENT Extract Con't ; 18-AUG-1997
  1.  ;;2.0;INCOME VERIFICATION MATCH;**9,11,15**; 21-OCT-94
  1.  ;
  1.  ;
  1. GOGO ; --
  1.  ; Description: This entry point will be the main driver for enrollment data extract.
  1.  ;
  1.  ;  Input:
  1.  ;    IVMCONST - as local array containing extract input parameters
  1.  ;               (constants), pass by reference
  1.  ;    IVMARRY1 - as local array containing extract input parameters
  1.  ;               (variable), pass by reference
  1.  ;
  1.  ; Output: None
  1.  ;
  1.  ; Perform enrollment data extract
  1.  D BULK(.IVMCONST,.IVMARRY1)
  1.  ;
  1.  ; Send extract notification message
  1.  D DOMAIL
  1.  ;
  1.  ; If enrollment events not on, turn on enrollment events
  1.  I '$$ON^IVMUPAR1() D SETON^IVMUPAR1
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. BULK(IVMCONST,IVMARRY1) ; --
  1.  ; Description: This entry point will perform the enrollment data extract.
  1.  ;
  1.  ;  Input:
  1.  ;    IVMCONST - as local array containing extract input parameters
  1.  ;               (constants), pass by reference
  1.  ;    IVMARRY1 - as local array containing extract input parameters
  1.  ;               (variable), pass by reference
  1.  ;
  1.  ; Output: None
  1.  ;
  1.  ; initilize varibles
  1.  N DFN,POP,Z
  1.  K IVMQUERY("LTD"),IVMQUERY("OVIS")
  1.  D INIT^IVMUFNC  ; HL7 vars
  1.  S (IVMARRY1("ERROR"),IVMARRY1("TERM"))=""
  1.  S IVMARRY1("HOST")=$S(IVMARRY1("HOST")'="":IVMARRY1("HOST"),1:IVMCONST("HOST"))
  1.  S IVMARRY1("PROC")=$G(IVMARRY1("PROC")),IVMARRY1("EXTRACT")=$G(IVMARRY1("EXTRACT"))  ; extract statistic counters
  1.  S IVMARRY1("START")=$$NOW^XLFDT  ; current date/time job started
  1.  S IVMARRY1("TASK")=$G(ZTSK)
  1.  ;
  1.  ; store processing info
  1.  I $$STORE^IVMBULK2(.IVMARRY1)
  1.  ;
  1.  ; open host file, if error quit
  1.  D OPEN^%ZISH("FILE1",IVMARRY1("DIR"),IVMARRY1("HOST")_"_"_(1+(IVMARRY1("EXTRACT")\IVMCONST("MSGMAX"))),"A")
  1.  I POP S IVMARRY1("ERROR")="Could not create host file in specified directory." G BULKQ
  1.  ;
  1.  ; loop through patients in Patient (#2) file
  1.  S DFN=+IVMARRY1("LASTPAT")
  1.  F  S DFN=$O(^DPT(DFN)) Q:'DFN  D  Q:IVMARRY1("ERROR")'=""
  1.  .;
  1.  .; - # of patients processed/checked
  1.  .S IVMARRY1("PROC")=IVMARRY1("PROC")+1
  1.  .;
  1.  .; - quit if patient does not pass selection criteria
  1.  .Q:'$$CRITERIA(DFN,IVMCONST("BEGDT"),DT)
  1.  .;
  1.  .; - kill ^TMP global containing previous HL7 msg
  1.  .K ^TMP("HLS",$J,HLSDT)
  1.  .;
  1.  .; - build HL7 full data transmission msg for patient
  1.  .D BUILD^IVMPTRN8(DFN,$$LD^IVMUFNC4(DFN),0,.IVMQUERY)
  1.  .;
  1.  .; - write HL7 full data transmission message to host file
  1.  .D HOST(HLSDT)
  1.  .;
  1.  .; - # of patients extracted
  1.  .S IVMARRY1("EXTRACT")=IVMARRY1("EXTRACT")+1
  1.  .;
  1.  .; - check if host file has reached max size limit
  1.  .I IVMARRY1("EXTRACT")#IVMCONST("MSGMAX")=0 D  Q:IVMARRY1("ERROR")'=""
  1.  ..;
  1.  ..; -- close host file, max limit reached
  1.  ..D CLOSE^%ZISH("FILE1")
  1.  ..;
  1.  ..; -- open next host file
  1.  ..D OPEN^%ZISH("FILE1",IVMARRY1("DIR"),IVMARRY1("HOST")_"_"_(1+(IVMARRY1("EXTRACT")\IVMCONST("MSGMAX"))),"A")
  1.  ..I POP S IVMARRY1("ERROR")="Could not open host file." Q
  1.  .;
  1.  .; - for every 100 patients processed, check if task stopped
  1.  .I IVMARRY1("PROC")#100=0 D
  1.  ..; -- check if task has been stopped
  1.  ..I $$S^%ZTLOAD S IVMARRY1("ERROR")="Queued job stopped prior to completion.",IVMARRY1("TERM")=1,IVMARRY1("LASTPAT")=DFN
  1.  ..; -- update IVM EXTRACT MANAGEMENT file
  1.  ..I $$STORE^IVMBULK2(.IVMARRY1)
  1.  ;
  1.  ;Close the last treatment date search and the outpt visit queries
  1.  F Z="LTD","OVIS" I $G(IVMQUERY(Z)) D CLOSE^SDQ(IVMQUERY(Z)) K IVMQUERY(Z)
  1.  ; close host file
  1.  D CLOSE^%ZISH("FILE1")
  1.  ;
  1.  ;
  1. BULKQ ; set up final extract statistics
  1.  I $G(DFN)'>0 S IVMARRY1("LASTPAT")=""
  1.  S IVMARRY1("STOP")=$$NOW^XLFDT  ; current date/time job stopped
  1.  S IVMARRY1("FILES")=(1+(IVMARRY1("EXTRACT")\IVMCONST("MSGMAX")))  ; # of host files
  1.  ; 
  1.  ; store processing info for extract in IVM Extract Management file
  1.  I $$STORE^IVMBULK2(.IVMARRY1)
  1.  ;
  1.  ; unlock IVM EXTRACT MANAGEMENT file
  1.  D UNLOCK^IVMBULK2(1)
  1.  ;
  1.  ; kill hl7 temp array
  1.  K ^TMP("HLS",$J,HLSDT)
  1.  ;
  1.  ; Cleanup HL7/IVM vars (as defined by call to INIT^IVMUFNC)
  1.  D CLEAN^IVMUFNC
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. CRITERIA(DFN,IVMDT1,IVMDT2) ; --
  1.  ; Description: This function will determine if the patient meets the enrollment initial data extract selection criteria for a specific date range.
  1.  ;
  1.  ;  Input:
  1.  ;       DFN - pointer to patient in Patient (#2) file
  1.  ;    IVMDT1 - as start date to use when looking for episodes of care
  1.  ;    IVMDT2 - as end date to use when looking for episodes of care
  1.  ;
  1.  ; Output:
  1.  ;   Function Value - Does patient meet the selection criteria?
  1.  ;                    Return 1 if successful, otherwise 0
  1.  ;
  1.  N IVMCRIT,IVMCUREN
  1.  S IVMCRIT=0
  1.  ;
  1.  ; get enrollment status from patient's current enrollment
  1.  S IVMCUREN=$$STATUS^DGENA(DFN),IVMCUREN=$G(IVMCUREN)
  1.  ; is status unverified, verified, or pending 
  1.  I IVMCUREN,(IVMCUREN=1!(IVMCUREN=2)!(IVMCUREN=9)) S IVMCRIT=1 G CRITQ
  1.  ;
  1.  ; if patient is not a veteran, exit
  1.  I '$$VET^DGENPTA(DFN) G CRITQ
  1.  ;
  1.  ; is veteran a current inpatient?
  1.  I $$CURINPAT^DGENPTA(DFN) S IVMCRIT=1 G CRITQ
  1.  ;
  1.  ; was veteran an inpatient?
  1.  I $$INPAT^DGENPTA(DFN,IVMDT1,IVMDT2) S IVMCRIT=1 G CRITQ
  1.  ;
  1.  ; does veteran have a checked-out encounter (outpatient)?
  1.  I $$OUTPAT^DGENPTA(DFN,IVMDT1,IVMDT2) S IVMCRIT=1 G CRITQ
  1.  ;
  1. CRITQ Q IVMCRIT
  1.  ;
  1.  ;
  1. HOST(HLSDT) ; --
  1.  ; Description: Take HL7 message contained in temporary array and write to host file.
  1.  ;
  1.  ;  Input:
  1.  ;                      IO - name of opened host file in the format to
  1.  ;                           to use for the 'M' USE command
  1.  ;    ^TMP("HLS",$J,HLSDT) - global array containing all segments of the
  1.  ;                           HL7 message for a patient.  The HLSDT
  1.  ;                           variable is a flag that indicates that data
  1.  ;                           is to be stored in the ^TMP("HLS") global
  1.  ;                           array.  The IVMCT variable is a sequential
  1.  ;                           number starting at 0 and incremented by 1.
  1.  ;
  1.  ; Output: None
  1.  ;
  1.  N IVMSUB
  1.  ;
  1.  ; use host file
  1.  U IO
  1.  ;
  1.  ; used to delineate begining of new HL7 message
  1.  W "{",!
  1.  ;
  1.  ; write message segments to host file
  1.  S IVMSUB="" F  S IVMSUB=$O(^TMP("HLS",$J,HLSDT,IVMSUB)) Q:IVMSUB'>0  D
  1.  .W $G(^TMP("HLS",$J,HLSDT,IVMSUB)),!
  1.  ;
  1.  ; used to delineate end of HL7 message
  1.  W "}",!
  1.  ;
  1.  Q
  1.  ;
  1.  ;
  1. DOMAIL ; --
  1.  ; Description: This function will generate a MailMan message contianing the results of the enrollment data extract.
  1.  ;
  1.  ;  Input: None
  1.  ;
  1.  ; Output: None
  1.  ;
  1.  K XMZ
  1.  N DIFROM,IVMCON1,IVMMSG,IVMPRCNT,IVMSITE,XMTEXT,XMSUB,XMDUZ,XMY
  1.  ;
  1.  ; init mail variables
  1.  S IVMSITE=$$SITE^VASITE
  1.  S XMSUB="Enrollment Extract Results "_"("_$P(IVMSITE,"^",3)_")"
  1.  S XMDUZ=.5,XMY(DUZ)="",XMY(.5)=""
  1.  S XMTEXT="IVMMSG("
  1.  ;
  1.  ; if error creating message text, exit
  1.  I '$$FINAL(.IVMMSG) G DOMAILQ
  1.  ;
  1.  ; get extract constants
  1.  I $$GETCONST^IVMBULK2(.IVMCON1)
  1.  ;
  1.  ; HEC mail group
  1.  I IVMARRY1("ERROR")']"" S XMY(IVMCON1("MAILGRP"))=""
  1.  ;
  1.  ; send msg
  1.  D ^XMD
  1.  ;
  1. DOMAILQ Q
  1.  ;
  1.  ;
  1. FINAL(IVMTXT) ; --
  1.  ; Description: Places message text into local IVMTXT array.
  1.  ;
  1.  ;  Input: None
  1.  ;
  1.  ; Output:
  1.  ;   Function Value - returns 1 if success, 0 if failure
  1.  ;   IVMTXT - as local array containing mail message text,
  1.  ;            pass by reference
  1.  ;
  1.  N SUCCESS,IVMSITE,IVMARRY2
  1.  S SUCCESS=0
  1.  ;
  1.  ; if obtaining IVM Extract Management record unsuccessful, exit
  1.  I '$$GET^IVMBULK2(.IVMARRY2) G FINALQ
  1.  ;
  1.  S IVMSITE=$$SITE^VASITE
  1.  ;
  1.  S IVMTXT(1)="    > > > > > > > > > >  ENROLLMENT DATA EXTRACT RESULTS  < < < < < < < < < <"
  1.  S IVMTXT(2)=""
  1.  S IVMTXT(3)="                       Facility Name:  "_$P(IVMSITE,"^",2)
  1.  S IVMTXT(4)="                      Station Number:  "_$P(IVMSITE,"^",3)
  1.  S IVMTXT(5)=""
  1.  S IVMTXT(6)="               Date/Time job started:  "_$$FMTE^XLFDT(IVMARRY2("START"),"1P")
  1.  S IVMTXT(7)="               Date/Time job stopped:  "_$$FMTE^XLFDT(IVMARRY2("STOP"),"1P")
  1.  S IVMTXT(8)=""
  1.  S IVMTXT(9)="            Total patients processed:  "_IVMARRY2("PROC")
  1.  S IVMTXT(10)="            Total patients extracted:  "_IVMARRY2("EXTRACT")
  1.  S IVMTXT(11)="                Percentage extracted:  "_$S($G(IVMARRY2("PROC")):$P(IVMARRY2("EXTRACT")/IVMARRY2("PROC")*100,".")_"%",1:"")
  1.  S IVMTXT(12)=""
  1.  S IVMTXT(13)="                 Host file directory:  "_IVMARRY2("DIR")
  1.  S IVMTXT(14)="                      Host file name:  "_IVMARRY2("HOST")
  1.  S IVMTXT(15)="                Number of host files:  "_IVMARRY2("FILES")
  1.  ;
  1.  ; if ERROR, set error into msg text
  1.  I IVMARRY2("ERROR")]"" D
  1.  .S IVMTXT(16)=""
  1.  .S IVMTXT(17)="               * * * * E R R O R  E N C O U N T E R E D * * * *"
  1.  .S IVMTXT(18)=""
  1.  .S IVMTXT(19)="          Error Message:  "_IVMARRY2("ERROR")
  1.  .S IVMTXT(20)="            Task Number:  "_IVMARRY2("TASK")
  1.  ;
  1.  S SUCCESS=1
  1.  ;
  1. FINALQ Q SUCCESS