DGPMV0.m

DGPMV0 ;ALB/MRL/MIR - SPECIAL LOOK-UP FOR LODGERS; 10 MAR 89

 ;;5.3;Registration;;Aug 13, 1993

SPCLU ;Special (quick) look-up for check-out lodgers

 S DGER=0,DIC="^DPT(",DIC(0)="EQMZ" R !,"Check-out PATIENT:  ",X:DTIME I '$T!(X["^")!(X="") S DGER=1 Q

 I X["?" D COHELP G SPCLU

 D ^DIC I Y'>0 G SPCLU

 I '$D(^DGPM("APTT4",+Y)) W !?5,"Patient was never a lodger ??" G SPCLU

 S DFN=+Y

 Q

COHELP ;help for check-out lodgers...list patients to choose from

 W !," ANSWER WITH PATIENT, OR SOCIAL SECURITY NUMBER, OR WARD LOCATION, OR",!,"     ROOM-BED",!,"CHOOSE FROM:"

 S (DGCT,DGFL)=0

 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

 D KVAR^VADPT K DGCT,DGFL,DFN,DIR,X,Y Q

WRITE ;write out identifiers

 I DGCT>(IOSL-4) S DIR(0)="E" D ^DIR I 'Y S DGFL=1 Q

 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)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGPMV0   948     printed  Apr 09, 2024@21:51:21                                                                                                                                                                                                       Page 2

DGPMV0    ;ALB/MRL/MIR - SPECIAL LOOK-UP FOR LODGERS; 10 MAR 89

 +1       ;;5.3;Registration;;Aug 13, 1993

SPCLU     ;Special (quick) look-up for check-out lodgers

 +1        SET DGER=0

           SET DIC="^DPT("

           SET DIC(0)="EQMZ"

           READ !,"Check-out PATIENT:  ",X:DTIME

           IF '$TEST!(X["^")!(X="")

               SET DGER=1

               QUIT 

 +2        IF X["?"

               DO COHELP

               GOTO SPCLU

 +3        DO ^DIC

           IF Y'>0

               GOTO SPCLU

 +4        IF '$DATA(^DGPM("APTT4",+Y))

               WRITE !?5,"Patient was never a lodger ??"

               GOTO SPCLU

 +5        SET DFN=+Y

 +6        QUIT 

COHELP    ;help for check-out lodgers...list patients to choose from

 +1        WRITE !," ANSWER WITH PATIENT, OR SOCIAL SECURITY NUMBER, OR WARD LOCATION, OR",!,"     ROOM-BED",!,"CHOOSE FROM:"

 +2        SET (DGCT,DGFL)=0

 +3        FOR DFN=0:0

               SET DFN=$ORDER(^DGPM("APTT4",DFN))

               if 'DFN

                   QUIT 

               IF $DATA(^DPT(DFN,0))

                   DO DEM^VADPT

                   IF VADM(1)]""

                       SET DGCT=DGCT+1

                       DO WRITE

                       if DGFL

                           QUIT 

 +4        DO KVAR^VADPT

           KILL DGCT,DGFL,DFN,DIR,X,Y

           QUIT 

WRITE     ;write out identifiers

 +1        IF DGCT>(IOSL-4)

               SET DIR(0)="E"

               DO ^DIR

               IF 'Y

                   SET DGFL=1

                   QUIT 

 +2        WRITE !?4,VADM(1),"   ",VA("PID"),"   "

           IF VADM(3)

               WRITE $EXTRACT(VADM(3),4,5),"-",$EXTRACT(VADM(3),6,7),"-",$EXTRACT(VADM(3),2,3)

 +3        QUIT