| 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 | ;
|
|---|
