Routine: ANSEAD1

ANSEAD1 ;IHS/OIRM/DSD/CSC - ENTER/EDIT ADMISSIONS; [ 02/25/98  10:32 AM ]

 ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996

 ;ENTER/EDIT ADMISSIONS

 Q:'$D(ANSPAR)

 S ANSADMS="",ANSS=$P(ANSPAR,U,5)

 I ANSDA,$D(^ANSR(ANSDA,0)) S ANSADMS=^(0)

 S ANSDT=$P(ANSADMS,U),ANSSH=$P(ANSADMS,U,2),(ANSUN,ANSUNX)=$P(ANSADMS,U,3)

 S ANSX=""

 I ANSDT S Y=ANSDT X ^DD("DD") S ANSX=Y

 S DIR(0)="DO^:"_DT,DIR("A")=$S(ANSTYPE="A":"Admission",1:"Discharge")_" Date"

 S:ANSX]"" DIR("B")=ANSX

W !

 D DIR^ANSDIC

 Q:$D(DTOUT)!$D(DUOUT)!($G(Y)<1)

 I Y>0,Y'>DT S X=Y D CHKD Q:'$D(Y)

 X ^DD("DD") S ANSDT=Y

 ;S ANSDT=$P(Y,".",1)

 W " "_ANSDT  ;CSC 10-97

 S ANSX=""

 I ANSSH S X=$T(@ANSS),ANSX=$P($P(X,";;",ANSSH+1),U,2)

 D SHIFT^ANSUD

 Q:$D(DTOUT)!$D(DUOUT)  ;CSC 10-97

 Q:'ANSSH

 S X=ANSSH

 D CHKS

 Q:'$D(Y)

 S ANSSH=Y

 D UNIT^ANSUD

 Q:$D(DTOUT)!$D(DUOUT)!'$G(ANSUN)

 I ANSUNX,ANSUN'=ANSUNX W *7,!!,"Patient must be discharged from the unit to which he/she is currently admitted." Q

 D ^ANSEAD2

CHKD S X=X_"."_ANSS,A=ANSADM

 I ANSDA D @(ANSTYPE_"OLD^ANSUCK") Q

 D @(ANSTYPE_"NEW^ANSUCK")

CHKS ;S X=ANSDT_"."_X,A=ANSADM

 S X=DT_"."_X,A=ANSADM  ;CSC 10-97

 I ANSDA D @(ANSTYPE_"OLD^ANSUCK") Q

 D @(ANSTYPE_"NEW^ANSUCK")

2 ;;1^DAY;;2^NIGHT

3 ;;1^DAY;;2^EVENING;;3^NIGHT

ANSEAD1   ;IHS/OIRM/DSD/CSC - ENTER/EDIT ADMISSIONS; [ 02/25/98  10:32 AM ]

 +1       ;;3.0;NURSING PATIENT ACUITY;;APR 01, 1996

 +2       ;ENTER/EDIT ADMISSIONS

 +3        IF '$DATA(ANSPAR)

               QUIT

 +4        SET ANSADMS=""

           SET ANSS=$PIECE(ANSPAR,U,5)

 +5        IF ANSDA

               IF $DATA(^ANSR(ANSDA,0))

                   SET ANSADMS=^(0)

 +6        SET ANSDT=$PIECE(ANSADMS,U)

           SET ANSSH=$PIECE(ANSADMS,U,2)

           SET (ANSUN,ANSUNX)=$PIECE(ANSADMS,U,3)

 +7        SET ANSX=""

 +8        IF ANSDT

               SET Y=ANSDT

               XECUTE ^DD("DD")

               SET ANSX=Y

 +9        SET DIR(0)="DO^:"_DT

           SET DIR("A")=$SELECT(ANSTYPE="A":"Admission",1:"Discharge")_" Date"

 +10       IF ANSX]""

               SET DIR("B")=ANSX

 +11       WRITE !

 +12       DO DIR^ANSDIC

 +13       IF $DATA(DTOUT)!$DATA(DUOUT)!($GET(Y)<1)

               QUIT

 +14       IF Y>0

               IF Y'>DT

                   SET X=Y

                   DO CHKD

                   IF '$DATA(Y)

                       QUIT

 +15       XECUTE ^DD("DD")

           SET ANSDT=Y

 +16      ;S ANSDT=$P(Y,".",1)

 +17      ;CSC 10-97

           WRITE " "_ANSDT

 +18       SET ANSX=""

 +19       IF ANSSH

               SET X=$TEXT(@ANSS)

               SET ANSX=$PIECE($PIECE(X,";;",ANSSH+1),U,2)

 +20       DO SHIFT^ANSUD

 +21      ;CSC 10-97

           IF $DATA(DTOUT)!$DATA(DUOUT)

               QUIT

 +22       IF 'ANSSH

               QUIT

 +23       SET X=ANSSH

 +24       DO CHKS

 +25       IF '$DATA(Y)

               QUIT

 +26       SET ANSSH=Y

 +27       DO UNIT^ANSUD

 +28       IF $DATA(DTOUT)!$DATA(DUOUT)!'$GET(ANSUN)

               QUIT

 +29       IF ANSUNX

               IF ANSUN'=ANSUNX

                   WRITE *7,!!,"Patient must be discharged from the unit to which he/she is currently admitted."

                   QUIT

 +30       DO ^ANSEAD2

 +31       QUIT

CHKD       SET X=X_"."_ANSS

           SET A=ANSADM

 +1        IF ANSDA

               DO @(ANSTYPE_"OLD^ANSUCK")

               QUIT

 +2        DO @(ANSTYPE_"NEW^ANSUCK")

 +3        QUIT

CHKS      ;S X=ANSDT_"."_X,A=ANSADM

 +1       ;CSC 10-97

           SET X=DT_"."_X

           SET A=ANSADM

 +2        IF ANSDA

               DO @(ANSTYPE_"OLD^ANSUCK")

               QUIT

 +3        DO @(ANSTYPE_"NEW^ANSUCK")

 +4        QUIT

2         ;;1^DAY;;2^NIGHT

3         ;;1^DAY;;2^EVENING;;3^NIGHT

ANSEAD1.m