source: FOIAVistA/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DGDIS1.m@ 1607

Last change on this file since 1607 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.6 KB
Line 
1DGDIS1 ;ALB/XAK-MRL - DISPOSITION PROCESSING ; 02/15/2004
2 ;;5.3;Registration;**151,568**;Aug 13, 1993
31 ;HOSPITAL, NHCU OR DOM ADMISSION
4A D DISPO^DGPMV K DGPMDER
5 Q
6 ;
72 ;"SCHEDULE ADMISSION FOR WARD
8 K %DT S DLAYGO=41.1,DIC(0)="L" I $D(^DGS(41.1,"B",DFN)) S DIC(0)="LEQ" K DLAYGO W !?7,*7,"SCHEDULED ADMISSION ALREADY ON FILE.",! F I=0:0 S I=$O(^DGS(41.1,"B",DFN,I)) Q:'I S DA=I,DIC="^DGS(41.1,",DR=0 D EN^DIQ
9REASK S DIC=41.1,X=$S('$D(DLAYGO):DFN,1:$P(^DPT(DFN,0),U,1)),D="B" S:$D(DLAYGO) DIC(0)=DIC(0)_"MZ" D @($S(X=DFN:"IX",1:"")_"^DIC") I Y<0,$D(DLAYGO) S X=$E(^DPT(DFN,0),1)_$E($P(^(0),U,9),6,9) D ^DIC
10 I $D(%Y),%Y["?" W !,"ENTER 'Y'ES OR 'N'O",! G REASK
1122 Q:Y'>0 S DGSKIP="",DGSCH=+Y S:$P(Y,"^",3) DGNEW=1 D EN^DGSCHAD K DGSKIP Q
12 ;Q:Y'>0 S DA=+Y,DR="[DGSCHADMIT]",DIE="^DGS(41.1,",DGSKIP=1 D ^DIE K DGSKIP Q
13 ;
143 ;WAITING LIST
15DIV W !,"Waiting List Entry",! S DIC="^DGWAIT(",DIC(0)="ZL",X=$S($D(^DG(40.8,+DIV,0)):$P(^(0),"^",1),1:"") D ^DIC G Q:Y'>0 S DIV=+Y
16 ;
17PAT S:'($D(^DGWAIT(+DIV,"P",0))\10) ^DGWAIT(DIV,"P",0)="^42.51PA^^" S D="B",DA(1)=DIV,DIC="^DGWAIT("_DIV_",""P"",",DIC(0)="ZL",DP=42.51,X=$P(^DPT(DFN,0),"^",1) D IX^DIC G Q:Y'>0 S DGWAIT=0 D EDIT^DGWAIT Q
18 ;
19Q Q
204 ;FUTURE APPOINTMENT
21 W !,"APPOINTMENTS CAN NO LONGER BE MADE USING THIS OPTION."
22 Q
23 ;
24CO(DFN,SDDT,SDISHDL,SDISDEL) ; -- ask check out questions
25 N DA,DFN1,DGDFN,DGDFN1,DGCO,DIE,DGODSND,SDCOQUIT,SDOE,Y
26 S SDISDEL=0
27 S SDOE=$$GETDISP^SDVSIT2(DFN,SDDT) G COQ:'SDOE
28 I '$$SCE^DGSDU(+SDOE,7,0) D INT^SDCO6(SDOE,.SDCOQUIT)
29 I '$D(SDCOQUIT),$$ASK^SDCO6 D EN^SDCO(SDOE,SDISHDL,1)
30 I '$$SCE^DGSDU(+SDOE,7,0) W !!,*7,"This disposition must be checked out to continue." S SDISDEL=1
31COQ Q
Note: See TracBrowser for help on using the repository browser.