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

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

initial load of FOIAVistA 6/30/08 version

File size: 2.9 KB
Line 
1DGQESC1 ;ALB/JFP - VIC INPATIENT 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 ;
5ENI ; -- Entry Point
6 N DIR,Y
7 S DIR(0)="YA"
8 S DIR("A")="Download all current Inpatients to the VIC card station "
9 S DIR("B")="NO"
10 S DIR("?")="Enter yes to download data."
11 D ^DIR
12 I Y D Q
13 .; -- New varaibles
14 .N DATE,DFNARR,CLINIC,DFN,ZTSTOP,CNT,RESULTS
15 .N VAUTD,VAUTNI
16 .N DGSUB,DGJ,DGUTP,DGWD,DGDV
17 .N DIVFLAG,DIVISION,SELDIV
18 .; -- Set variables
19 .S VAUTD=1 ; -- All divisions selected
20 .S CNT=0
21 .D NOW^%DTC S DATE=%
22 .S DFNARR="^TMP(""DGQE-DFN"","_$J_")"
23 .K @DFNARR
24 .; -- Check for multi divisional hospital
25 .I $P(^DG(43,1,"GL"),"^",2)=1 D Q:Y=-1
26 ..D DIVISION^VAUTOMA
27 .; -- Check for wards within division or all
28 .S VAUTNI=2
29 .D WARD^VAUTOMA
30 .I Y=-1 Q
31 .; -- Task off job
32 .S DIR(0)="YA"
33 .S DIR("A")="Queue job: "
34 .S DIR("B")="YES"
35 .S DIR("?")="Enter YES or NO to have job run in background"
36 .D ^DIR
37 .Q:$D(DIRUT)
38 .I Y D Q
39 ..D BATCH
40 ..I '$D(ZTSK) Q
41 ..W !,"Card(s) queued, task number = "_ZTSK
42 .; -- Builds an array of inpatients to download
43 .D INSCAN
44 Q
45 ;
46EXIT ; -- Finish processing
47 I '$D(ZTQUEUED)&($P(RESULTS,"^",1)=0) W !!,CNT_" Inpatients down loaded to VIC work station"
48 K @DFNARR
49 Q
50 ;
51INSCAN ; -- Scans all ward locations for inpatients
52 I '$D(ZTQUEUED) W !!,"Note: Each dot equals a ward",!,"."
53 ; -- scan INPATIENT clinics
54 S (CLINIC,DFN)=""
55 F S CLINIC=$O(^DPT("CN",CLINIC)) Q:(CLINIC="") D
56 .; -- Check to see if users wants task to stop
57 .I $$S^%ZTLOAD D Q
58 ..S ZTSTOP=1
59 .I VAUTD=0 D CHKDIV Q:'DIVFLAG
60 .I '$D(ZTQUEUED) W "."
61 .S DFN=""
62 .F S DFN=$O(^DPT("CN",CLINIC,DFN)) Q:(DFN="") D
63 ..;W !,"DFN = ",DFN
64 ..S @DFNARR@(DFN)=""
65HL7 ; -- Builds HL7 batch message
66 S DFN=""
67 F S DFN=$O(@DFNARR@(DFN)) Q:'DFN S CNT=CNT+1
68 S RESULTS=$$EVENT^DGQEHL72("A08",DFNARR)
69 I '$D(ZTQUEUED)&($P(RESULTS,"^",1)=-1) D
70 .W !,"Inpatient data not downloaded. Error - ",$P(RESULTS,"^",2)
71 ; -- Clean up variables
72 D EXIT
73 Q
74 ;
75CHKDIV ; -- Check to see if clinic is part of Division selected
76 ; -- re-sequences array
77 S DGSUB="" F DGJ=1:1 S DGSUB=$O(VAUTD(DGSUB)) Q:DGSUB="" S DGUTD(DGJ)=$G(VAUTD(DGSUB))
78 ;
79 S DIVFLAG=0
80 S DGWD=$O(^DIC(42,"B",CLINIC,0))
81 I DGWD S DGDV=$S('$D(^DIC(42,DGWD,0)):0,+$P(^(0),"^",11):$P(^(0),"^",11),1:$O(^DG(40.8,0)))
82 I DGDV=0 S DIVFLAG=0 Q
83 S DIVISION=$P($G(^DG(40.8,DGDV,0)),U,1)
84 I DIVISION="" S DIVFLAG=0 Q
85 ;W !,"DIVISION = ",DIVISION
86 F DGJ=1:1 S SELDIV=DGUTD(DGJ) D Q:'$D(DGUTD(DGJ+1))
87 .;W !,"SELDIV = ",SELDIV
88 .I SELDIV=DIVISION S DIVFLAG=1 Q
89 Q
90 ;
91BATCH ; -- Entry point for placing cards on hold
92 N ZTRTN,ZTDESCO,ZTIO,ZTDTH,ZTSAVE,G
93 ;
94 S ZTRTN="INSCAN^DGQESC1"
95 S ZTDESC="Download Inpatients to VIC work station via HL7"
96 S ZTIO=""
97 K ZTDTH
98 ;D NOW^%DTC S ZTDTH=%
99 F G="VAUTD","DFNARR","CNT" S:$D(@G) ZTSAVE(G)=""
100 S ZTSAVE("VAUTD(")=""
101 D ^%ZTLOAD
102 Q
103 ;
104END ; -- End of Code
105 Q
106 ;
Note: See TracBrowser for help on using the repository browser.