ANSEAD3 ;IHS/OIRM/DSD/CSC - ENTER/EDIT ADMISSIONS/DISCHARGES; [ 02/25/98 10:32 AM ]
;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
;;ADD/EDIT ADMISSIONS & DISCHARGES
D HEAD
S X=$P(^DPT(ANSDFN,0),U)
W !!,$P(X,","),", ",$P(X,",",2,99)
I ANSSITE,$D(^AUPNPAT(ANSDFN,41,ANSSITE,0)) S X=$P(^(0),U,2) I X]"" W " (",X,")"
D DISP
A1 S DIR(0)="YO",DIR("A")="DELETE the Entire Admission",DIR("B")="NO",DIR("?")="You may delete this admission and all of it's associated data."
D DIR^ANSDIC
Q:$D(DTOUT)!$D(DUOUT)
I Y'=1 D B0 Q
W *7
A2 S DIR(0)="YO",DIR("A",1)="This Admission and all of the associated Acuity data will be deleted.",DIR("A")="Are You certain you want to do this",DIR("B")="YES"
D DIR^ANSDIC
Q:$D(DTOUT)!$D(DUOUT)!($G(Y)'=1)
W !!,"Standby..."
D DEL
W:$X>60 !
W " Done."
Q
B0 S (L,D)=0,N="" ;CSC 12/19/96 (N="")
;I $D(^ANSR("PT",ANSDFN,ANSDA)) G ^ANSEAD1
Q:$D(^ANSR("PT",ANSDFN,ANSDA))
S D=9999999-^ANSR(ANSDA,0)
B1 F S N=$O(^ANSR("AA",ANSDFN,D,N)) Q:N="" S L=N
Q:L'=ANSDA
B2 S DIR(0)="YO",DIR("A")="Delete The Discharge",DIR("B")="NO"
S DIR("?",1)="Because this is the last Admission, you may choose to delete",DIR("?",1)="the Dischage and thus make the Admission 'CURRENT' again."
D DIR^ANSDIC
Q:$D(DTOUT)!$D(DUOUT)
Q:Y'=1
S (X,D)=""
S X=$P($D(^ANSR(ANSDA,"DX")),U,5)
I X,$D(^ANSR(X,0)) S D=+^(0),S=$P(^(0),U,2)
I 'D W *7,!!,"Unable to delete Discharge." H 3 Q
S ^ANSR("PT",ANSDFN,ANSDA)=""
S DA=X,DIK="^ANSR("
I ANSDA'=X D DIK^ANSDIC K ^ANSR(ANSDA,"AT",D_"."_S,X)
S:ANSDA=X $P(^ANSR(X,0),U,5)="A"
S $P(^ANSR(ANSDA,"DX"),U,5)=""
W !!,"Deleted."
Q
DEL S (A,C)=0
F S A=$O(^ANSR(ANSDA,"AT",A)) Q:A="" D
.S B=0
.S B=$O(^ANSR(ANSDA,"AT",A,B)) Q:B="" D:$D(^ANSR(B,0))
..S X=^ANSR(B,0),C=C+1,D=+X
..S DA=B,DIK="^ANSR("
..D DIK^ANSDIC
I $D(^ANSR("PT",ANSDFN,ANSDA)) K ^(ANSDA)
S D=0
I $D(^ANSR(ANSDA,0)) S DA=ANSDA,DIK="^ANSR(" D DIK^ANSDIC
Q
DAT S Y=""
Q:X'?7N
S Y=$P("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",+$E(X,4,5))_" "_($E(X,6,7))_", "_($E(X,1,3)+1700)
Q
HEAD W @IOF
S X=$P(ANSPAR,U,2)
W ?80-$L(X)\2,X,!,?28,"ADMIT/DISCHARGE PATIENTS",!!
Q
DISP Q:'$D(^ANSR(ANSDA,0))
S A=^ANSR(ANSDA,0),B=$G(^("DX"))
S Y=$P(A,U)
Q:'Y
X ^DD("DD")
W !!,"Admitted On"," ",Y
S X=$P(B,U,5)
I 'X W " (Active Inpatient)" Q
I $D(^ANSR(X,0)) S X=$P(^(0),U) I Y D
.X ^DD("DD")
.W " Discharged On ",Y
Q
ANSEAD3 ;IHS/OIRM/DSD/CSC - ENTER/EDIT ADMISSIONS/DISCHARGES; [ 02/25/98 10:32 AM ]
+1 ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
+2 ;;ADD/EDIT ADMISSIONS & DISCHARGES
+3 DO HEAD
+4 SET X=$PIECE(^DPT(ANSDFN,0),U)
+5 WRITE !!,$PIECE(X,","),", ",$PIECE(X,",",2,99)
+6 IF ANSSITE
IF $DATA(^AUPNPAT(ANSDFN,41,ANSSITE,0))
SET X=$PIECE(^(0),U,2)
IF X]""
WRITE " (",X,")"
+7 DO DISP
A1 SET DIR(0)="YO"
SET DIR("A")="DELETE the Entire Admission"
SET DIR("B")="NO"
SET DIR("?")="You may delete this admission and all of it's associated data."
+1 DO DIR^ANSDIC
+2 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+3 IF Y'=1
DO B0
QUIT
+4 WRITE *7
A2 SET DIR(0)="YO"
SET DIR("A",1)="This Admission and all of the associated Acuity data will be deleted."
SET DIR("A")="Are You certain you want to do this"
SET DIR("B")="YES"
+1 DO DIR^ANSDIC
+2 IF $DATA(DTOUT)!$DATA(DUOUT)!($GET(Y)'=1)
QUIT
+3 WRITE !!,"Standby..."
+4 DO DEL
+5 IF $X>60
WRITE !
+6 WRITE " Done."
+7 QUIT
B0 ;CSC 12/19/96 (N="")
SET (L,D)=0
SET N=""
+1 ;I $D(^ANSR("PT",ANSDFN,ANSDA)) G ^ANSEAD1
+2 IF $DATA(^ANSR("PT",ANSDFN,ANSDA))
QUIT
+3 SET D=9999999-^ANSR(ANSDA,0)
B1 FOR
SET N=$ORDER(^ANSR("AA",ANSDFN,D,N))
IF N=""
QUIT
SET L=N
+1 IF L'=ANSDA
QUIT
B2 SET DIR(0)="YO"
SET DIR("A")="Delete The Discharge"
SET DIR("B")="NO"
+1 SET DIR("?",1)="Because this is the last Admission, you may choose to delete"
SET DIR("?",1)="the Dischage and thus make the Admission 'CURRENT' again."
+2 DO DIR^ANSDIC
+3 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+4 IF Y'=1
QUIT
+5 SET (X,D)=""
+6 SET X=$PIECE($DATA(^ANSR(ANSDA,"DX")),U,5)
+7 IF X
IF $DATA(^ANSR(X,0))
SET D=+^(0)
SET S=$PIECE(^(0),U,2)
+8 IF 'D
WRITE *7,!!,"Unable to delete Discharge."
HANG 3
QUIT
+9 SET ^ANSR("PT",ANSDFN,ANSDA)=""
+10 SET DA=X
SET DIK="^ANSR("
+11 IF ANSDA'=X
DO DIK^ANSDIC
KILL ^ANSR(ANSDA,"AT",D_"."_S,X)
+12 IF ANSDA=X
SET $PIECE(^ANSR(X,0),U,5)="A"
+13 SET $PIECE(^ANSR(ANSDA,"DX"),U,5)=""
+14 WRITE !!,"Deleted."
+15 QUIT
DEL SET (A,C)=0
+1 FOR
SET A=$ORDER(^ANSR(ANSDA,"AT",A))
IF A=""
QUIT
Begin DoDot:1
+2 SET B=0
+3 SET B=$ORDER(^ANSR(ANSDA,"AT",A,B))
IF B=""
QUIT
IF $DATA(^ANSR(B,0))
Begin DoDot:2
+4 SET X=^ANSR(B,0)
SET C=C+1
SET D=+X
+5 SET DA=B
SET DIK="^ANSR("
+6 DO DIK^ANSDIC
End DoDot:2
End DoDot:1
+7 IF $DATA(^ANSR("PT",ANSDFN,ANSDA))
KILL ^(ANSDA)
+8 SET D=0
+9 IF $DATA(^ANSR(ANSDA,0))
SET DA=ANSDA
SET DIK="^ANSR("
DO DIK^ANSDIC
+10 QUIT
DAT SET Y=""
+1 IF X'?7N
QUIT
+2 SET Y=$PIECE("Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec"," ",+$EXTRACT(X,4,5))_" "_($EXTRACT(X,6,7))_", "_($EXTRACT(X,1,3)+1700)
+3 QUIT
HEAD WRITE @IOF
+1 SET X=$PIECE(ANSPAR,U,2)
+2 WRITE ?80-$LENGTH(X)\2,X,!,?28,"ADMIT/DISCHARGE PATIENTS",!!
+3 QUIT
DISP IF '$DATA(^ANSR(ANSDA,0))
QUIT
+1 SET A=^ANSR(ANSDA,0)
SET B=$GET(^("DX"))
+2 SET Y=$PIECE(A,U)
+3 IF 'Y
QUIT
+4 XECUTE ^DD("DD")
+5 WRITE !!,"Admitted On"," ",Y
+6 SET X=$PIECE(B,U,5)
+7 IF 'X
WRITE " (Active Inpatient)"
QUIT
+8 IF $DATA(^ANSR(X,0))
SET X=$PIECE(^(0),U)
IF Y
Begin DoDot:1
+9 XECUTE ^DD("DD")
+10 WRITE " Discharged On ",Y
End DoDot:1
+11 QUIT
