| [613] | 1 | DGQESC3 ;ALB/JFP - VIC PREADMIT SCAN ROUTINE ; 01/09/96
|
|---|
| 2 | ;;V5.3;REGISTRATION;**73**;DEC 11,1996
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ENS ; -- Entry point
|
|---|
| 6 | N DIR,Y
|
|---|
| 7 | ;
|
|---|
| 8 | S DIR(0)="YA"
|
|---|
| 9 | S DIR("A")="Download Scheduled Admissions to the VIC card station "
|
|---|
| 10 | S DIR("B")="NO"
|
|---|
| 11 | S DIR("?")="Enter yes to download data."
|
|---|
| 12 | D ^DIR
|
|---|
| 13 | I Y D Q
|
|---|
| 14 | .; -- New Variables
|
|---|
| 15 | .N VAUTD
|
|---|
| 16 | .N DATE,DFNARR,CNT,Y,ERR,SDATE,EDATE,CLINIC,DFN,LDATE,IFN,ZTSTOP,RESULTS
|
|---|
| 17 | .N DGSNODE,DGSUB,DGJ,DGUTD,DGDV
|
|---|
| 18 | .N DIVFLAG,DIVISION,SELDIV
|
|---|
| 19 | .; -- Set variables
|
|---|
| 20 | .S VAUTD=1 ; -- All divisions selected
|
|---|
| 21 | .D NOW^%DTC S DATE=%
|
|---|
| 22 | .S DFNARR="^TMP(""DGQE-DFN"","_$J_")"
|
|---|
| 23 | .K @DFNARR
|
|---|
| 24 | .S CNT=0
|
|---|
| 25 | .; -- Check for multi divisional hospital
|
|---|
| 26 | .I $P(^DG(43,1,"GL"),"^",2)=1 D Q:Y=-1
|
|---|
| 27 | ..D DIVISION^VAUTOMA
|
|---|
| 28 | .; -- Download for date range
|
|---|
| 29 | .S ERR=$$SDATE^DGQESC0()
|
|---|
| 30 | .I ERR=-1 Q
|
|---|
| 31 | .S SDATE=ERR
|
|---|
| 32 | .S ERR=$$EDATE^DGQESC0(ERR)
|
|---|
| 33 | .I ERR=-1 Q
|
|---|
| 34 | .S EDATE=ERR
|
|---|
| 35 | .; -- Task off job
|
|---|
| 36 | .S DIR(0)="YA"
|
|---|
| 37 | .S DIR("A")="Task job: "
|
|---|
| 38 | .S DIR("B")="YES"
|
|---|
| 39 | .S DIR("?")="Enter YES/NO to determine whether job is tasked"
|
|---|
| 40 | .D ^DIR
|
|---|
| 41 | .Q:$D(DIRUT)
|
|---|
| 42 | .I Y D Q
|
|---|
| 43 | ..D BATCH
|
|---|
| 44 | ..I '$D(ZTSK) Q
|
|---|
| 45 | ..W !,"Card(s) queued, task number = "_ZTSK
|
|---|
| 46 | .D PRESCAN
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | EXIT ; -- Finish processing
|
|---|
| 50 | I '$D(ZTQUEUED)&($P(RESULTS,"^",1)=0) W !!,CNT_" Scheduled admissions down loaded to VIC work station"
|
|---|
| 51 | K @DFNARR
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | PRESCAN ; -- Scans for scheduled admissions
|
|---|
| 55 | I '$D(ZTQUEUED) W !!,"Note: Each dot equals a day",!,"."
|
|---|
| 56 | ; -- scan scheduled admissions
|
|---|
| 57 | S (CLINIC,DFN)=""
|
|---|
| 58 | S LDATE=SDATE
|
|---|
| 59 | F S LDATE=$O(^DGS(41.1,"C",LDATE)) Q:(LDATE="")!($P(LDATE,".",1)>EDATE) D
|
|---|
| 60 | .I '$D(ZTQUEUED) W "."
|
|---|
| 61 | .S IFN=""
|
|---|
| 62 | .F S IFN=$O(^DGS(41.1,"C",LDATE,IFN)) Q:IFN="" D
|
|---|
| 63 | ..S DGSNODE=$G(^DGS(41.1,IFN,0))
|
|---|
| 64 | ..; -- Check cancelled flag
|
|---|
| 65 | ..I $P(DGSNODE,"^",13)'="" Q
|
|---|
| 66 | ..; -- Check batch cancelled flag
|
|---|
| 67 | ..I $$S^%ZTLOAD D Q
|
|---|
| 68 | ...S ZTSTOP=1
|
|---|
| 69 | ..I VAUTD=0 D CHKDIV Q:'DIVFLAG
|
|---|
| 70 | ..S DFN=$P(DGSNODE,"^",1)
|
|---|
| 71 | ..; -- Places card in hold file
|
|---|
| 72 | ..S @DFNARR@(DFN)=""
|
|---|
| 73 | HL7 ; -- Builds HL7 batch message
|
|---|
| 74 | S DFN=""
|
|---|
| 75 | F S DFN=$O(@DFNARR@(DFN)) Q:'DFN S CNT=CNT+1
|
|---|
| 76 | S RESULTS=$$EVENT^DGQEHL72("A08",DFNARR)
|
|---|
| 77 | I $D(JPTEST) W !,"Results = ",RESULTS
|
|---|
| 78 | I '$D(ZTQUEUED)&($P(RESULTS,"^",1)=-1) D
|
|---|
| 79 | .W !,"Scheduled admission data not downloaded. Error - ",$P(RESULTS,"^",2)
|
|---|
| 80 | ; -- Clean up variables
|
|---|
| 81 | D EXIT
|
|---|
| 82 | Q
|
|---|
| 83 | ;
|
|---|
| 84 | CHKDIV ; -- Check to see if clinic is part of Division selected
|
|---|
| 85 | ; -- re-sequences array
|
|---|
| 86 | S DGSUB="" F DGJ=1:1 S DGSUB=$O(VAUTD(DGSUB)) Q:DGSUB="" S DGUTD(DGJ)=$G(VAUTD(DGSUB))
|
|---|
| 87 | ;
|
|---|
| 88 | S DIVFLAG=0
|
|---|
| 89 | S DGDV=$P(DGSNODE,"^",12)
|
|---|
| 90 | I DGDV="" S DIVFLAG=0 Q
|
|---|
| 91 | S DIVISION=$P($G(^DG(40.8,DGDV,0)),U,1)
|
|---|
| 92 | I DIVISION="" S DIVFLAG=0 Q
|
|---|
| 93 | F DGJ=1:1 S SELDIV=DGUTD(DGJ) D Q:'$D(DGUTD(DGJ+1))
|
|---|
| 94 | .I SELDIV=DIVISION S DIVFLAG=1 Q
|
|---|
| 95 | Q
|
|---|
| 96 | ;
|
|---|
| 97 | BATCH ; -- Batch entry point for placing cards on hold
|
|---|
| 98 | N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSAVE,G
|
|---|
| 99 | ;
|
|---|
| 100 | S ZTRTN="PRESCAN^DGQESC3"
|
|---|
| 101 | S ZTDESC="Scheduled admissions download to VIC work station via HL7"
|
|---|
| 102 | S ZTIO=""
|
|---|
| 103 | K ZTDTH
|
|---|
| 104 | ;D NOW^%DTC S ZTDTH=%
|
|---|
| 105 | F G="VAUTD","CNT","DFNARR","SDATE","EDATE" S:$D(@G) ZTSAVE(G)=""
|
|---|
| 106 | S ZTSAVE("VAUTD(")=""
|
|---|
| 107 | D ^%ZTLOAD
|
|---|
| 108 | Q
|
|---|
| 109 | ;
|
|---|
| 110 | END ; -- End of Code
|
|---|
| 111 | Q
|
|---|
| 112 | ;
|
|---|
