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 ---[H[J[2J[HDGSWITCH 1270 printed Dec 13, 2024@02:59:02 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
