| 1 | DGSCHAD ;ALB/MRL - SCHEDULED ADMISSIONS ENTRY/CANCEL ;12/4/91 14:14 ;
|
|---|
| 2 | ;;5.3;Registration;**117,187**;Aug 13, 1993
|
|---|
| 3 | ;OERR MODIFICATIONS
|
|---|
| 4 | 1 ;Schedule Admission
|
|---|
| 5 | D Q S DGNEW=0 K ORACTION G Q:$D(DGSKIP) W !! S DIC("A")="Schedule admission for patient: ",DIC(0)="AEZQLM"
|
|---|
| 6 | 11 S DLAYGO=41.1,DIC("S")="I '$P(^DGS(41.1,+Y,0),""^"",13)",DIC="^DGS(41.1," D ^DIC K DLAYGO,DIC("S"),DIC("A") G Q:Y'>0 S DGSCH=+Y,DFN=+$P(Y,"^",2)
|
|---|
| 7 | EN S DGNEW=+$P(Y,U,3) I 'DGNEW&($D(ORACTION)) W !,"Editing is not allowed through this option, only adding",*7,! G Q
|
|---|
| 8 | I $D(^DPT(+$P(^(0),"^",1),.35)),+^(.35) S Y=^(.35) X ^DD("DD") W !!,*7,"PATIENT DIED ON ",Y,"...CAN'T SCHEDULED ADMIT FOR EXPIRED PATIENT!!" D:DGNEW KILL G Q:$D(ORACTION),1:'$D(DGSKIP),Q
|
|---|
| 9 | S (DA,Y)=DGSCH,DR="[DGSCHADMIT]",DIE=DIC D DIV^DGUTL,^DIE,SA G 1:DGERR I $S('$D(^DGS(41.1,"B",DFN)):1,'$D(^DPT(DFN,.3)):1,$P(^DPT(DFN,.3),"^",1)'="N":1,1:0) G Q:$D(ORACTION),1:'$D(DGSKIP),Q
|
|---|
| 10 | K DFN1,DGPMDA,DGJJ G Q:$D(DGSKIP)
|
|---|
| 11 | TP W ! D ASK^DGBLRV
|
|---|
| 12 | G Q:$D(ORACTION),1:'$D(DGPMDA) Q
|
|---|
| 13 | 2 ;Cancel Scheduled Admission
|
|---|
| 14 | D WARN W !! S DIC("A")="Cancel scheduled admission for patient: ",DIC("S")="I '$P(^DGS(41.1,+Y,0),""^"",13)",DIC(0)="AEZQM",DIC="^DGS(41.1," D ^DIC K DIC("A"),DIC("S") G Q:Y'>0 S DGSCH=+Y
|
|---|
| 15 | W !!,*7,"All questions must be answered or this scheduled admission won't be cancelled!!" S (DA,Y)=DGSCH,DIE=DIC,DR="13;14////^S X=DUZ;15;16;" D ^DIE,CA,Q G 2
|
|---|
| 16 | Q
|
|---|
| 17 | SA ;Check SA for missing data
|
|---|
| 18 | W ! S DGSCH1=$S($D(^DGS(41.1,+DGSCH,0)):^(0),1:"") I DGSCH1']"" S DGERR=0 Q
|
|---|
| 19 | S DGERR=0,DGERSUB="PATIENT NAME^DATE OF RESERVATION^LENGTH OF STAY EXPECTED^ADMITTING DIAGNOSIS^PROVIDER^SURGERY^OPT/NSC STATUS^^^WARD OR TREATING SPECIALTY^^DIVISION"
|
|---|
| 20 | F I=1,2,4,5,10,12 I $P(DGSCH1,"^",I)']"" S DGERR=1 W !?4,"> ",$P(DGERSUB,"^",I)," is not specified."
|
|---|
| 21 | I $P(DGSCH1,"^",10)="W",$P(DGSCH1,"^",8)']"" S DGERR=1 W !?4,"> WARD location to which admit is scheduled is not specified."
|
|---|
| 22 | I $P(DGSCH1,"^",10)="T",$P(DGSCH1,"^",9)']"" S DGERR=1 W !?4,"> TREATING SPECIALTY to which admit is scheduled is unspecified."
|
|---|
| 23 | W !!,*7,"[",$S('DGERR:"ADMISSION HAS BEEN",1:"NOTHING")," SCHEDULED",$S('DGERR:"",1:"...ACTION DELETED"),"]" D:DGERR KILL Q
|
|---|
| 24 | CA ;Check for missing CA data
|
|---|
| 25 | W ! S DGERR=0,DGERR1="",DGERSUB="DATE/TIME CANCELLED^CANCELLED BY^REASON CANCELLED^WAS PATIENT NOTIFIED",DGSCH1=$S($D(^DGS(41.1,+DGSCH,0)):^(0),1:"") I DGSCH1']"" Q
|
|---|
| 26 | F I=13:1:16 S:$P(DGSCH1,"^",I)]"" DGERR1=DGERR1_I_"///@;" I $P(DGSCH1,"^",I)']"" W !?4,"> ",$P(DGERSUB,"^",I-12)," is unspecified." S DGERR=1
|
|---|
| 27 | W !!,*7,"...Scheduled Admission has ",$S(DGERR:"not ",1:""),"been Cancelled..." Q:'DGERR I $L(DGERR1) S DIE="^DGS(41.1,",DIC(0)="AEQMZ",DR=DGERR1 D ^DIE K DR
|
|---|
| 28 | Q
|
|---|
| 29 | WARN D Q D:'$D(DT) DT^DICRW Q
|
|---|
| 30 | KILL S DIK="^DGS(41.1,",DA=DGSCH D ^DIK K DIK Q
|
|---|
| 31 | Q K DGNEW,DGERR,DGERR1,DGERSUB,DGSCH,DGSCH1,DFN1,DIC,DIE,DR,X,Y,DGSDIV,DA,DIK,I Q
|
|---|
| 32 | OREN D Q S XQORQUIT=1,DGNEW=0,DIC(0)="ELN",X=+ORVP D 11 Q
|
|---|
| 33 | ;
|
|---|
| 34 | WACT(DGW,DGDT) ;ward active on scheduled admit date?
|
|---|
| 35 | ; input: DGW = ien of WARD LOCATION file
|
|---|
| 36 | ; DGDT = date of interest - defaults to DT
|
|---|
| 37 | ; returns: 1 if active
|
|---|
| 38 | ; 0 if inactive (out-of-service)
|
|---|
| 39 | ; -1 if error
|
|---|
| 40 | ;
|
|---|
| 41 | N DGX,DGY
|
|---|
| 42 | I '$D(DGW) Q -1
|
|---|
| 43 | I '$D(^DIC(42,DGW,0)) Q -1
|
|---|
| 44 | S DGY=$S($D(DGDT):DGDT,1:DT) I $P(DGY,".",1)'?7N Q -1
|
|---|
| 45 | S DGX=+$O(^DIC(42,DGW,"OOS","B",DGY+.1),-1),DGX=$S($D(^DIC(42,DGW,"OOS",+$O(^(+DGX,0)),0)):^(0),1:"")
|
|---|
| 46 | I '$P(DGX,U,6) Q 1
|
|---|
| 47 | I $P(DGX,U,6),'$P(DGX,U,4) Q 0
|
|---|
| 48 | I $P(DGX,U,6),$P(DGX,U,4)'>DGY Q 1
|
|---|
| 49 | Q 0
|
|---|
