- 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
