source: FOIAVistA/tag/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGQESC3.m@ 1416

Last change on this file since 1416 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1DGQESC3 ;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 ;
5ENS ; -- 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 ;
49EXIT ; -- 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 ;
54PRESCAN ; -- 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)=""
73HL7 ; -- 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 ;
84CHKDIV ; -- 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 ;
97BATCH ; -- 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 ;
110END ; -- End of Code
111 Q
112 ;
Note: See TracBrowser for help on using the repository browser.