1 | DGQESC1 ;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 | ;
|
---|
5 | ENI ; -- 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 | ;
|
---|
46 | EXIT ; -- 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 | ;
|
---|
51 | INSCAN ; -- 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)=""
|
---|
65 | HL7 ; -- 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 | ;
|
---|
75 | CHKDIV ; -- 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 | ;
|
---|
91 | BATCH ; -- 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 | ;
|
---|
104 | END ; -- End of Code
|
---|
105 | Q
|
---|
106 | ;
|
---|