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

DGQESC3.m

Go to the documentation of this file. 
  1. DGQESC3 ;ALB/JFP - VIC PREADMIT SCAN ROUTINE ; 01/09/96
  1.  ;;5.3;REGISTRATION;**73,1015**;DEC 11,1996;Build 21
  1.  ;;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. ENS ; -- Entry point
  1.  N DIR,Y
  1.  ;
  1.  S DIR(0)="YA"
  1.  S DIR("A")="Download Scheduled Admissions to the VIC card station "
  1.  S DIR("B")="NO"
  1.  S DIR("?")="Enter yes to download data."
  1.  D ^DIR
  1.  I Y D  Q
  1.  .; -- New Variables
  1.  .N VAUTD
  1.  .N DATE,DFNARR,CNT,Y,ERR,SDATE,EDATE,CLINIC,DFN,LDATE,IFN,ZTSTOP,RESULTS
  1.  .N DGSNODE,DGSUB,DGJ,DGUTD,DGDV
  1.  .N DIVFLAG,DIVISION,SELDIV
  1.  .; -- Set variables
  1.  .S VAUTD=1 ; -- All divisions selected
  1.  .D NOW^%DTC S DATE=%
  1.  .S DFNARR="^TMP(""DGQE-DFN"","_$J_")"
  1.  .K @DFNARR
  1.  .S CNT=0
  1.  .; -- Check for multi divisional hospital
  1.  .I $P(^DG(43,1,"GL"),"^",2)=1 D  Q:Y=-1
  1.  ..D DIVISION^VAUTOMA
  1.  .; -- Download for date range
  1.  .S ERR=$$SDATE^DGQESC0()
  1.  .I ERR=-1 Q
  1.  .S SDATE=ERR
  1.  .S ERR=$$EDATE^DGQESC0(ERR)
  1.  .I ERR=-1 Q
  1.  .S EDATE=ERR
  1.  .; -- Task off job
  1.  .S DIR(0)="YA"
  1.  .S DIR("A")="Task job: "
  1.  .S DIR("B")="YES"
  1.  .S DIR("?")="Enter YES/NO to determine whether job is tasked"
  1.  .D ^DIR
  1.  .Q:$D(DIRUT)
  1.  .I Y D  Q
  1.  ..D BATCH
  1.  ..I '$D(ZTSK) Q
  1.  ..W !,"Card(s) queued, task number = "_ZTSK
  1.  .D PRESCAN
  1.  Q
  1.  ;
  1. EXIT ; -- Finish processing
  1.  I '$D(ZTQUEUED)&($P(RESULTS,"^",1)=0) W !!,CNT_" Scheduled admissions down loaded to VIC work station"
  1.  K @DFNARR
  1.  Q
  1.  ;
  1. PRESCAN ; -- Scans for scheduled admissions
  1.  I '$D(ZTQUEUED) W !!,"Note: Each dot equals a day",!,"."
  1.  ; -- scan scheduled admissions
  1.  S (CLINIC,DFN)=""
  1.  S LDATE=SDATE
  1.  F  S LDATE=$O(^DGS(41.1,"C",LDATE)) Q:(LDATE="")!($P(LDATE,".",1)>EDATE)  D
  1.  .I '$D(ZTQUEUED) W "."
  1.  .S IFN=""
  1.  .F  S IFN=$O(^DGS(41.1,"C",LDATE,IFN)) Q:IFN=""  D
  1.  ..S DGSNODE=$G(^DGS(41.1,IFN,0))
  1.  ..; -- Check cancelled flag
  1.  ..I $P(DGSNODE,"^",13)'="" Q
  1.  ..; -- Check batch cancelled flag
  1.  ..I $$S^%ZTLOAD D  Q
  1.  ...S ZTSTOP=1
  1.  ..I VAUTD=0 D CHKDIV  Q:'DIVFLAG
  1.  ..S DFN=$P(DGSNODE,"^",1)
  1.  ..; -- Places card in hold file
  1.  ..S @DFNARR@(DFN)=""
  1. HL7 ; -- Builds HL7 batch message
  1.  S DFN=""
  1.  F  S DFN=$O(@DFNARR@(DFN)) Q:'DFN  S CNT=CNT+1
  1.  S RESULTS=$$EVENT^DGQEHL72("A08",DFNARR)
  1.  I $D(JPTEST) W !,"Results = ",RESULTS
  1.  I '$D(ZTQUEUED)&($P(RESULTS,"^",1)=-1) D
  1.  .W !,"Scheduled admission data not downloaded. Error - ",$P(RESULTS,"^",2)
  1.  ; -- Clean up variables
  1.  D EXIT
  1.  Q
  1.  ;
  1. CHKDIV ; -- Check to see if clinic is part of Division selected
  1.  ; -- re-sequences array
  1.  S DGSUB="" F DGJ=1:1 S DGSUB=$O(VAUTD(DGSUB)) Q:DGSUB=""  S DGUTD(DGJ)=$G(VAUTD(DGSUB))
  1.  ;
  1.  S DIVFLAG=0
  1.  S DGDV=$P(DGSNODE,"^",12)
  1.  I DGDV="" S DIVFLAG=0 Q
  1.  S DIVISION=$P($G(^DG(40.8,DGDV,0)),U,1)
  1.  I DIVISION="" S DIVFLAG=0 Q
  1.  F DGJ=1:1 S SELDIV=DGUTD(DGJ) D  Q:'$D(DGUTD(DGJ+1))
  1.  .I SELDIV=DIVISION S DIVFLAG=1 Q 
  1.  Q
  1.  ;
  1. BATCH ; -- Batch entry point for placing cards on hold
  1.  N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,G
  1.  ;
  1.  S ZTRTN="PRESCAN^DGQESC3"
  1.  S ZTDESC="Scheduled admissions download to VIC work station via HL7"
  1.  S ZTIO=""
  1.  K ZTDTH
  1.  ;D NOW^%DTC S ZTDTH=%
  1.  F G="VAUTD","CNT","DFNARR","SDATE","EDATE" S:$D(@G) ZTSAVE(G)=""
  1.  S ZTSAVE("VAUTD(")=""
  1.  D ^%ZTLOAD
  1.  Q
  1.  ;
  1. END ; -- End of Code
  1.  Q
  1.  ;