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

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

initial load of WorldVistAEHR

File size: 930 bytes
Line 
1DGPMV0 ;ALB/MRL/MIR - SPECIAL LOOK-UP FOR LODGERS; 10 MAR 89
2 ;;5.3;Registration;;Aug 13, 1993
3SPCLU ;Special (quick) look-up for check-out lodgers
4 S DGER=0,DIC="^DPT(",DIC(0)="EQMZ" R !,"Check-out PATIENT: ",X:DTIME I '$T!(X["^")!(X="") S DGER=1 Q
5 I X["?" D COHELP G SPCLU
6 D ^DIC I Y'>0 G SPCLU
7 I '$D(^DGPM("APTT4",+Y)) W !?5,"Patient was never a lodger ??" G SPCLU
8 S DFN=+Y
9 Q
10COHELP ;help for check-out lodgers...list patients to choose from
11 W !," ANSWER WITH PATIENT, OR SOCIAL SECURITY NUMBER, OR WARD LOCATION, OR",!," ROOM-BED",!,"CHOOSE FROM:"
12 S (DGCT,DGFL)=0
13 F DFN=0:0 S DFN=$O(^DGPM("APTT4",DFN)) Q:'DFN I $D(^DPT(DFN,0)) D DEM^VADPT I VADM(1)]"" S DGCT=DGCT+1 D WRITE Q:DGFL
14 D KVAR^VADPT K DGCT,DGFL,DFN,DIR,X,Y Q
15WRITE ;write out identifiers
16 I DGCT>(IOSL-4) S DIR(0)="E" D ^DIR I 'Y S DGFL=1 Q
17 W !?4,VADM(1)," ",VA("PID")," " I VADM(3) W $E(VADM(3),4,5),"-",$E(VADM(3),6,7),"-",$E(VADM(3),2,3)
18 Q
Note: See TracBrowser for help on using the repository browser.