| 1 | DGPMV0 ;ALB/MRL/MIR - SPECIAL LOOK-UP FOR LODGERS; 10 MAR 89
|
|---|
| 2 | ;;5.3;Registration;;Aug 13, 1993
|
|---|
| 3 | SPCLU ;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
|
|---|
| 10 | COHELP ;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
|
|---|
| 15 | WRITE ;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
|
|---|
