Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DGSWITCH

DGSWITCH.m

Go to the documentation of this file.
DGSWITCH ;SF/GFT/MIR - SWITCH BEDS ; 5/17/88  10:54 AM ;
 ;;5.3;Registration;**128,1015**;Aug 13, 1993;Build 21
 ;
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