ANSEAD ;IHS/OIRM/DSD/CSC - ENTER/EDIT ADMISSIONS/DISCHARGES; [ 02/25/98 10:32 AM ]
;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
EN N A,B,C,D,H,I,F,L,N,M,P,S,X,Y,Z
D EN1
EXIT K ANS,ANSD,ANSADM,ANSTYPE,ANSADMS,ANSDA,ANSDT,ANSU,ANSUN,ANSS,ANSSH
K ANSR,ANSB,ANSDC,ANSDX,ANSX
Q
EN1 K ANSDFN
D HEAD,^ANSUPT
Q:$D(DTOUT)!$D(DUOUT)!'$D(ANSDFN)
S ANSADM=$O(^ANSR("PT",ANSDFN,0)),ANSTYPE="A",ANSDA=0
D DISP
I ANSADM="" D ADM I 1
E D DSCH
Q
ADM S DIR(0)="YO",DIR("A")="Admit This Patient",DIR("B")="NO"
W !
D DIR^ANSDIC
Q:$D(DTOUT)!$D(DUOUT)
I Y'=1 D PRI Q
D B1
Q
DSCH S DIR(0)="YO",DIR("A")="Discharge This Patient",DIR("B")="NO"
W !
D DIR^ANSDIC
Q:$D(DTOUT)!$D(DUOUT)
I Y'=1 D EDIT Q
S ANSTYPE="D"
D B1
Q
EDIT S DIR(0)="YO",DIR("A")="Edit This Admission",DIR("B")="NO"
W !
D DIR^ANSDIC
Q:$D(DTOUT)!$D(DUOUT)
I Y'=1 D PRI Q
S ANSDA=ANSADM
D B1
Q
PRI S ANSD=$O(^ANSR("AA",ANSDFN,0))
Q:ANSD=""
PRI1 S DIR(0)="YO",DIR("A")="Edit A Prior Admission",DIR("B")="NO"
W !
D DIR^ANSDIC
Q:$D(DTOUT)!$D(DUOUT)
Q:Y'=1
D ^ANSUAD
Q:$D(DTOUT)!$D(DUOUT)!'$D(ANSADM)
S ANSDA=ANSADM
D ^ANSEAD3
Q
B1 D ^ANSEAD1
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 D ^ANSMENU
S ANSX="ADMIT/DISCHARGE PATIENTS"
W !!,?80-$L(ANSX)/2,ANSX
Q
DISP I ANSADM D DISP1 Q
W !!,"Not Currently An Inpatient"
S D=$O(^ANSR("AA",ANSDFN,0))
I D="" W " (No Prior Admissions Recorded)" Q
S L=0,X=""
F I=1:1 S L=$O(^ANSR("AA",ANSDFN,D,L)) Q:L="" S X=L
S P=1
DISP1 I ANSADM S X=ANSADM,P=0
DISP2 Q:'$D(^ANSR(X,0))
S A=^ANSR(X,0),B=$G(^("DX"))
S Y=$P(A,U)
Q:'Y
X ^DD("DD")
W !!,$S(P:"Last Admission",1:"Admitted On")," ",Y
I P S X=$P(B,U,5) I X,$D(^ANSR(X,0)) S Y=$P(^(0),U) I Y X ^DD("DD") W " Discharged On ",Y Q
Q:P
DISP3 S Y=$P(B,U,2)
Q:'Y
Q:'$D(^ANSD(59.1,Y,0))
W !!,"Current Location: ",$P(^ANSD(59.1,Y,0),U) S Y=$P(B,U,3)
I Y,$D(^ANSD(59.1,Y,"R",Y,0)) W " Rm ",$P(^(0),U) S Y=$P(B,U,4) I Y,$D(^("B",Y,0)) W "-",$P(^(0),U)
S Y=$P(B,U)
I Y]"" W !!,"Diagnosis: ",Y
Q
ANSEAD ;IHS/OIRM/DSD/CSC - ENTER/EDIT ADMISSIONS/DISCHARGES; [ 02/25/98 10:32 AM ]
+1 ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
EN NEW A,B,C,D,H,I,F,L,N,M,P,S,X,Y,Z
+1 DO EN1
EXIT KILL ANS,ANSD,ANSADM,ANSTYPE,ANSADMS,ANSDA,ANSDT,ANSU,ANSUN,ANSS,ANSSH
+1 KILL ANSR,ANSB,ANSDC,ANSDX,ANSX
+2 QUIT
EN1 KILL ANSDFN
+1 DO HEAD
DO ^ANSUPT
+2 IF $DATA(DTOUT)!$DATA(DUOUT)!'$DATA(ANSDFN)
QUIT
+3 SET ANSADM=$ORDER(^ANSR("PT",ANSDFN,0))
SET ANSTYPE="A"
SET ANSDA=0
+4 DO DISP
+5 IF ANSADM=""
DO ADM
IF 1
+6 IF '$TEST
DO DSCH
+7 QUIT
ADM SET DIR(0)="YO"
SET DIR("A")="Admit This Patient"
SET DIR("B")="NO"
+1 WRITE !
+2 DO DIR^ANSDIC
+3 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+4 IF Y'=1
DO PRI
QUIT
+5 DO B1
+6 QUIT
DSCH SET DIR(0)="YO"
SET DIR("A")="Discharge This Patient"
SET DIR("B")="NO"
+1 WRITE !
+2 DO DIR^ANSDIC
+3 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+4 IF Y'=1
DO EDIT
QUIT
+5 SET ANSTYPE="D"
+6 DO B1
+7 QUIT
EDIT SET DIR(0)="YO"
SET DIR("A")="Edit This Admission"
SET DIR("B")="NO"
+1 WRITE !
+2 DO DIR^ANSDIC
+3 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+4 IF Y'=1
DO PRI
QUIT
+5 SET ANSDA=ANSADM
+6 DO B1
+7 QUIT
PRI SET ANSD=$ORDER(^ANSR("AA",ANSDFN,0))
+1 IF ANSD=""
QUIT
PRI1 SET DIR(0)="YO"
SET DIR("A")="Edit A Prior Admission"
SET DIR("B")="NO"
+1 WRITE !
+2 DO DIR^ANSDIC
+3 IF $DATA(DTOUT)!$DATA(DUOUT)
QUIT
+4 IF Y'=1
QUIT
+5 DO ^ANSUAD
+6 IF $DATA(DTOUT)!$DATA(DUOUT)!'$DATA(ANSADM)
QUIT
+7 SET ANSDA=ANSADM
+8 DO ^ANSEAD3
+9 QUIT
B1 DO ^ANSEAD1
+1 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 DO ^ANSMENU
+1 SET ANSX="ADMIT/DISCHARGE PATIENTS"
+2 WRITE !!,?80-$LENGTH(ANSX)/2,ANSX
+3 QUIT
DISP IF ANSADM
DO DISP1
QUIT
+1 WRITE !!,"Not Currently An Inpatient"
+2 SET D=$ORDER(^ANSR("AA",ANSDFN,0))
+3 IF D=""
WRITE " (No Prior Admissions Recorded)"
QUIT
+4 SET L=0
SET X=""
+5 FOR I=1:1
SET L=$ORDER(^ANSR("AA",ANSDFN,D,L))
IF L=""
QUIT
SET X=L
+6 SET P=1
DISP1 IF ANSADM
SET X=ANSADM
SET P=0
DISP2 IF '$DATA(^ANSR(X,0))
QUIT
+1 SET A=^ANSR(X,0)
SET B=$GET(^("DX"))
+2 SET Y=$PIECE(A,U)
+3 IF 'Y
QUIT
+4 XECUTE ^DD("DD")
+5 WRITE !!,$SELECT(P:"Last Admission",1:"Admitted On")," ",Y
+6 IF P
SET X=$PIECE(B,U,5)
IF X
IF $DATA(^ANSR(X,0))
SET Y=$PIECE(^(0),U)
IF Y
XECUTE ^DD("DD")
WRITE " Discharged On ",Y
QUIT
+7 IF P
QUIT
DISP3 SET Y=$PIECE(B,U,2)
+1 IF 'Y
QUIT
+2 IF '$DATA(^ANSD(59.1,Y,0))
QUIT
+3 WRITE !!,"Current Location: ",$PIECE(^ANSD(59.1,Y,0),U)
SET Y=$PIECE(B,U,3)
+4 IF Y
IF $DATA(^ANSD(59.1,Y,"R",Y,0))
WRITE " Rm ",$PIECE(^(0),U)
SET Y=$PIECE(B,U,4)
IF Y
IF $DATA(^("B",Y,0))
WRITE "-",$PIECE(^(0),U)
+5 SET Y=$PIECE(B,U)
+6 IF Y]""
WRITE !!,"Diagnosis: ",Y
+7 QUIT
