DGSWITCH.m

DGSWITCH ;SF/GFT/MIR - SWITCH BEDS ; 5/17/88  10:54 AM ;

 ;;5.3;Registration;**128**;Aug 13, 1993

 ;

EN K ^UTILITY("DGPM",$J) S (DGSWITCH,DGOERR)=0,XQORQUIT=1 K ORACTION

 R !!,"SWITCH BED FOR PATIENT: ",X:DTIME G Q:X["^"!'$T!(X="") S DIC(0)="QZEM",DIC("S")="I $D(^(.1))" S DIC="^DPT(" D ^DIC G EN:Y'>0 S DFN=+Y

OERR D INP^DGRPD I 'DGPMVI(1) W *7,!?5,"NO ADMISSIONS ON FILE!" G REASK

 W ! I DGPMDCD W !,"Patient is not in-house!",*7 G REASK

 S DIE="^DGPM(",DR=.07,DA=DGPMVI(13),I=DGPMVI(13,1)+.0000005 I $O(^DGPM("APCA",DFN,+DGPMVI(13),I))'>0 S DGPMT=1 D DIE G REASK

 S I=$O(^DGPM("APMV",DFN,+DGPMVI(13),0)),I=$O(^(+I,0)) I I>0,$D(^DGPM(+I,0)) S X="^"_$P(^(0),"^",18)_"^" I "^2^3^13^25^26^43^44^45^"[X W !,"Not while ",$S("^2^3^25^26^"[X:"on absence",1:"ASIH") G REASK

 S DA=I,DGPMT=2 D DIE

REASK G EN:'$D(ORACTION)

Q D KVAR^VADPT K:'$D(ORACTION) XQORQUIT K DFN,DGPMDA,DGPMDCD,DGPMA,DGPMOC,DGPMOS,DGPMP,DGPMT,DGPMVI,DGOERR,DGSWITCH,DIC,A,D,DA,DR,I,X,Y,DIE,^UTILITY("DGPM",$J) Q

OREN S DGPMDA="",DGSWITCH=0 Q:'$D(ORVP)  S (Y,DFN)=+ORVP G OERR

DIE I $D(^DGPM(+DA,0)) S DGPMDA=DA,(DGPMP,^UTILITY("DGPM",$J,DGPMT,DA,"P"))=^(0) D ^DIE S (DGPMA,^UTILITY("DGPM",$J,DGPMT,DA,"A"))=^DGPM(DA,0) D RESET^DGPMDDCN

 I $D(DGPMP),(DGPMP'=DGPMA) D EN^DGPMVBM,^DGPMEVT

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DGSWITCH   1270     printed  Apr 09, 2024@21:50:22                                                                                                                                                                                                    Page 2

DGSWITCH  ;SF/GFT/MIR - SWITCH BEDS ; 5/17/88  10:54 AM ;

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

 +2       ;

EN         KILL ^UTILITY("DGPM",$JOB)

           SET (DGSWITCH,DGOERR)=0

           SET XQORQUIT=1

           KILL ORACTION

 +1        READ !!,"SWITCH BED FOR PATIENT: ",X:DTIME

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

               GOTO Q

           SET DIC(0)="QZEM"

           SET DIC("S")="I $D(^(.1))"

           SET DIC="^DPT("

           DO ^DIC

           if Y'>0

               GOTO EN

           SET DFN=+Y

OERR       DO INP^DGRPD

           IF 'DGPMVI(1)

               WRITE *7,!?5,"NO ADMISSIONS ON FILE!"

               GOTO REASK

 +1        WRITE !

           IF DGPMDCD

               WRITE !,"Patient is not in-house!",*7

               GOTO REASK

 +2        SET DIE="^DGPM("

           SET DR=.07

           SET DA=DGPMVI(13)

           SET I=DGPMVI(13,1)+.0000005

           IF $ORDER(^DGPM("APCA",DFN,+DGPMVI(13),I))'>0

               SET DGPMT=1

               DO DIE

               GOTO REASK

 +3        SET I=$ORDER(^DGPM("APMV",DFN,+DGPMVI(13),0))

           SET I=$ORDER(^(+I,0))

           IF I>0

               IF $DATA(^DGPM(+I,0))

                   SET X="^"_$PIECE(^(0),"^",18)_"^"

                   IF "^2^3^13^25^26^43^44^45^"[X

                       WRITE !,"Not while ",$SELECT("^2^3^25^26^"[X:"on absence",1:"ASIH")

                       GOTO REASK

 +4        SET DA=I

           SET DGPMT=2

           DO DIE

REASK      if '$DATA(ORACTION)

               GOTO EN

Q          DO KVAR^VADPT

           if '$DATA(ORACTION)

               KILL XQORQUIT

           KILL DFN,DGPMDA,DGPMDCD,DGPMA,DGPMOC,DGPMOS,DGPMP,DGPMT,DGPMVI,DGOERR,DGSWITCH,DIC,A,D,DA,DR,I,X,Y,DIE,^UTILITY("DGPM",$JOB)

           QUIT 

OREN       SET DGPMDA=""

           SET DGSWITCH=0

           if '$DATA(ORVP)

               QUIT 

           SET (Y,DFN)=+ORVP

           GOTO OERR

DIE        IF $DATA(^DGPM(+DA,0))

               SET DGPMDA=DA

               SET (DGPMP,^UTILITY("DGPM",$JOB,DGPMT,DA,"P"))=^(0)

               DO ^DIE

               SET (DGPMA,^UTILITY("DGPM",$JOB,DGPMT,DA,"A"))=^DGPM(DA,0)

               DO RESET^DGPMDDCN

 +1        IF $DATA(DGPMP)

               IF (DGPMP'=DGPMA)

                   DO EN^DGPMVBM

                   DO ^DGPMEVT

 +2        QUIT