ANSEAD2.m

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