- ANSEAD2 ;IHS/OIRM/DSD/CSC - ENTER/EDIT ADMISSIONS; [ 02/25/98 10:32 AM ]
- ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
- ;;ADD/EDIT ADMISSIONS
- Z D LST
- S F=1
- I 'ANSDA D NUM S (ANSADM,ANSDA,L)=+Y,F=0
- I ANSTYPE="D" D DC Q
- AD I F D VAR
- D STR
- S ANSDC=$P($G(^ANSR(ANSDA,"DX")),U,5)
- D CUR
- I L=ANSADM,N=ANSADM,$D(^ANSR("PT",ANSDFN,ANSADM)) D RB
- Q
- DC I F D VAR
- D STR
- I L=ANSADM K ^ANSR("PT",ANSDFN)
- S DIE="^ANSR(",DA=ANSADM,DR="6////"_ANSDA
- D DIE^ANSDIC
- Q
- STR S DIE="^ANSR(",DA=ANSDA,DR=".01///"_ANSDT_";.02////"_ANSSH_";.03////"_ANSUN_";.04////"_ANSDFN_";.05////"_ANSTYPE_";.06////"_ANSADM_";.07////"_DUZ
- D DIE^ANSDIC
- Q
- VAR S P=0
- F I="ANSDT","ANSSH","ANSUN" S P=P+1,@I=$P(ANSADMS,U,P)
- Q
- NUM S DIC="^ANSR(",DIC(0)="L",X=ANSDT
- D FILE^ANSDIC
- Q
- LST S (N,Y)=0,L="",D=$O(^ANSR("AA",ANSDFN,0))
- Q:D=""
- F S N=$O(^ANSR("AA",ANSDFN,D,N)) Q:N="" I $D(^ANSR(N,0)) S X=$P(^ANSR(N,0),U)_"."_$P(^(0),U,2) S:X>Y X=Y,L=N
- Q
- CUR S N=ANSADM,M=0
- F S M=$O(^ANSR(ANSADM,"AT",M)) Q:M="" D
- .S O=0
- .F S O=$O(^ANSR(ANSADM,"AT",M,O)) Q:O="" I $D(^ANSR(O,0)),$P(^(0),U,5)'="D" D
- ..S N=O
- S V=$P(^ANSR(N,0),U,3),X=""
- I V'=$P($G(^ANSR(ANSADM,"DX")),U,2) S DIE="^ANSR(",DA=ANSADM,DR="3////"_V_";4///@;5///@" D DIE^ANSDIC
- Q
- RB S ANSUN=V,ANSDX=$G(^ANSR(ANSDA,"DX"))
- D ^ANSUEU
- Q
- ANSEAD2 ;IHS/OIRM/DSD/CSC - ENTER/EDIT ADMISSIONS; [ 02/25/98 10:32 AM ]
- +1 ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996
- +2 ;;ADD/EDIT ADMISSIONS
- Z DO LST
- +1 SET F=1
- +2 IF 'ANSDA
- DO NUM
- SET (ANSADM,ANSDA,L)=+Y
- SET F=0
- +3 IF ANSTYPE="D"
- DO DC
- QUIT
- AD IF F
- DO VAR
- +1 DO STR
- +2 SET ANSDC=$PIECE($GET(^ANSR(ANSDA,"DX")),U,5)
- +3 DO CUR
- +4 IF L=ANSADM
- IF N=ANSADM
- IF $DATA(^ANSR("PT",ANSDFN,ANSADM))
- DO RB
- +5 QUIT
- DC IF F
- DO VAR
- +1 DO STR
- +2 IF L=ANSADM
- KILL ^ANSR("PT",ANSDFN)
- +3 SET DIE="^ANSR("
- SET DA=ANSADM
- SET DR="6////"_ANSDA
- +4 DO DIE^ANSDIC
- +5 QUIT
- STR SET DIE="^ANSR("
- SET DA=ANSDA
- SET DR=".01///"_ANSDT_";.02////"_ANSSH_";.03////"_ANSUN_";.04////"_ANSDFN_";.05////"_ANSTYPE_";.06////"_ANSADM_";.07////"_DUZ
- +1 DO DIE^ANSDIC
- +2 QUIT
- VAR SET P=0
- +1 FOR I="ANSDT","ANSSH","ANSUN"
- SET P=P+1
- SET @I=$PIECE(ANSADMS,U,P)
- +2 QUIT
- NUM SET DIC="^ANSR("
- SET DIC(0)="L"
- SET X=ANSDT
- +1 DO FILE^ANSDIC
- +2 QUIT
- LST SET (N,Y)=0
- SET L=""
- SET D=$ORDER(^ANSR("AA",ANSDFN,0))
- +1 IF D=""
- QUIT
- +2 FOR
- SET N=$ORDER(^ANSR("AA",ANSDFN,D,N))
- IF N=""
- QUIT
- IF $DATA(^ANSR(N,0))
- SET X=$PIECE(^ANSR(N,0),U)_"."_$PIECE(^(0),U,2)
- IF X>Y
- SET X=Y
- SET L=N
- +3 QUIT
- CUR SET N=ANSADM
- SET M=0
- +1 FOR
- SET M=$ORDER(^ANSR(ANSADM,"AT",M))
- IF M=""
- QUIT
- Begin DoDot:1
- +2 SET O=0
- +3 FOR
- SET O=$ORDER(^ANSR(ANSADM,"AT",M,O))
- IF O=""
- QUIT
- IF $DATA(^ANSR(O,0))
- IF $PIECE(^(0),U,5)'="D"
- Begin DoDot:2
- +4 SET N=O
- End DoDot:2
- End DoDot:1
- +5 SET V=$PIECE(^ANSR(N,0),U,3)
- SET X=""
- +6 IF V'=$PIECE($GET(^ANSR(ANSADM,"DX")),U,2)
- SET DIE="^ANSR("
- SET DA=ANSADM
- SET DR="3////"_V_";4///@;5///@"
- DO DIE^ANSDIC
- +7 QUIT
- RB SET ANSUN=V
- SET ANSDX=$GET(^ANSR(ANSDA,"DX"))
- +1 DO ^ANSUEU
- +2 QUIT
