17 lines
1.2 KiB
Mathematica
17 lines
1.2 KiB
Mathematica
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
|