ANSUPT.m

ANSUPT ;IHS/OIRM/DSD/CSC - SELECT PATIENT; [ 02/25/98  10:32 AM ]

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

 ;;SELECT PATIENT

A1 D:$G(ANSCOUNT)<1 MSG

 K ANSDFN

 S DIC="^AUPNPAT(",DIC(0)="AEMQZ",DIC("A")="Enter Patient's Name or Chart NO.: "

 D DIC^ANSDIC

 S:$G(Y)>0 ANSDFN=+Y

 Q

INPATAR ;SET UP INPATIENT ARRAY

 K ^TMP("ANSPA",$J),DUOUT

 S ANSX="",ANSX=$O(^ANSR("PT",ANSX))

 I ANSX="" W *7,!!,?10,"No current inpatients....." Q

 S ANSX=""

 F  S ANSX=$O(^ANSR("PT",ANSX)) Q:ANSX=""!$D(DUOUT)  D ARRAY

 D:'$D(DUOUT) INPAT

 K DUOUT

 Q

ARRAY ;SET UP VARIABLES AND TEMPORARY INPAT GLOBAL

 S (ANSINPT,ANSUNIT,ANSROOM,ANSBED)=""

 S (ANSPUNIT,ANSPROOM,ANSPBED)=0

 I '$D(^DPT(ANSX,0)) Q

 S ANSINPT=$P(^DPT(ANSX,0),U)

 S ANSY=$O(^ANSR("PT",ANSX,""))

 Q:'ANSY

 Q:'$D(^ANSR(ANSY,0))!'$D(^("DX"))

 S ANSPUNIT=$P(^ANSR(ANSY,"DX"),U,2),ANSUNIT=$S(ANSPUNIT:^ANSD(59.1,ANSPUNIT,0),1:"NOT SPECIFIED")

 S ANSPROOM=$P(^ANSR(ANSY,"DX"),U,3),ANSROOM=$S(ANSPUNIT&ANSPROOM:^ANSD(59.1,ANSPUNIT,"R",ANSPROOM,0),1:"UNK")

 S ANSBED=$S(ANSPUNIT&ANSPROOM&($P(^ANSR(ANSY,"DX"),U,4)):^ANSD(59.1,ANSPUNIT,"R",ANSPROOM,"B",$P(^ANSR(ANSY,"DX"),U,4),0),1:"UNK")

 D CURASS

 S ^TMP("ANSPA",$J,ANSINPT,ANSUNIT,ANSROOM,ANSBED,ANSCADT)=""

 Q

INPAT ;PRINT INPATIENT ARRAY HEADING

 W !!,?5,"You may choose one of the following inpatients:"

 W !,"================================================================================"

 W !,"LAST ASSESS",!,"DATE",?7,"SHFT",?17,"NAME",?50,"UNIT",?67,"ROOM",?77,"BED"

 W !,"-----  ----",?13,"-----------------------------------",?50,"---------------",?67,"--------",?77,"---"

 S ANSZ=0,(ANSINPT,ANSUNIT,ANSROOM,ANSBED,ANSCADT)=""

 F  S ANSINPT=$O(^TMP("ANSPA",$J,ANSINPT)) Q:ANSINPT=""!$D(DUOUT)  D PARRAY

 Q

PARRAY ;SET PRINT ARRAY VARIALBES

 S (ANSUNIT,ANSROOM,ANSBED,ANSCADT)=""

 S ANSUNIT=$O(^TMP("ANSPA",$J,ANSINPT,ANSUNIT))

 S:ANSUNIT ANSROOM=$O(^TMP("ANSPA",$J,ANSINPT,ANSUNIT,ANSROOM))

 S:ANSROOM ANSBED=$O(^TMP("ANSPA",$J,ANSINPT,ANSUNIT,ANSROOM,ANSBED))

 S:ANSBED ANSCADT=$O(^TMP("ANSPA",$J,ANSINPT,ANSUNIT,ANSROOM,ANSBED,ANSCADT))

 S ANSZ=ANSZ+1

 D:'$D(DUOUT) LIST

 Q

LIST ;PRINT LIST OF INPATIENTS

 I ANSCADT["NONE" W !,"NONE"

 E  W !,$E(ANSCADT,4,5)_"-"_$E(ANSCADT,6,7),?9,$P(ANSCADT,".",2)

 W ?13,$E(ANSINPT,1,35),?50,ANSUNIT,?67,ANSROOM,?77,ANSBED

 D LIST1:ANSZ>17

 Q

LIST1 I ANSINPT]"" D

 .W !!,?10,"There are additional inpatients."

 .D PAUSE^ANSDIC S ANSZ=0

 Q

CURASS ;FIND DATE AND SHIFT OF MOST RECENT ASSESSMENT

 S (ANSCA,ANSCADT)="",(AST,AST1)=0

 I '$D(^ANSR(ANSY,"AT")) S ANSCADT="   NONE" Q

 F  S ANSCA=$O(^ANSR(ANSY,"AT",ANSCA)) Q:ANSCA=""  S AST=AST+1

 D ANSCADT

 Q

ANSCADT F I=0:1:AST-1 S ANSCADT=$O(^ANSR(ANSY,"AT",ANSCADT))

 Q

MSG ;EP;

 S ANSCOUNT=1,DIR(0)="YO",DIR("A")="Do you want to see a list of current inpatients",DIR("B")="NO"

 W !

 D DIR^ANSDIC

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

 D INPATAR

 K ^TMP("ANSPA",$J),ANSX,ANSINPT,ANSUNIT,ANSROOM,ANSBED,ANSPUNIT,ANSPROOM,ANSPBED,ANSZ

 Q

ANSUPT    ;IHS/OIRM/DSD/CSC - SELECT PATIENT; [ 02/25/98  10:32 AM ]

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

 +2       ;;SELECT PATIENT

A1         IF $GET(ANSCOUNT)<1

               DO MSG

 +1        KILL ANSDFN

 +2        SET DIC="^AUPNPAT("

           SET DIC(0)="AEMQZ"

           SET DIC("A")="Enter Patient's Name or Chart NO.: "

 +3        DO DIC^ANSDIC

 +4        IF $GET(Y)>0

               SET ANSDFN=+Y

 +5        QUIT 

INPATAR   ;SET UP INPATIENT ARRAY

 +1        KILL ^TMP("ANSPA",$JOB),DUOUT

 +2        SET ANSX=""

           SET ANSX=$ORDER(^ANSR("PT",ANSX))

 +3        IF ANSX=""

               WRITE *7,!!,?10,"No current inpatients....."

               QUIT 

 +4        SET ANSX=""

 +5        FOR 

               SET ANSX=$ORDER(^ANSR("PT",ANSX))

               IF ANSX=""!$DATA(DUOUT)

                   QUIT 

               DO ARRAY

 +6        IF '$DATA(DUOUT)

               DO INPAT

 +7        KILL DUOUT

 +8        QUIT 

ARRAY     ;SET UP VARIABLES AND TEMPORARY INPAT GLOBAL

 +1        SET (ANSINPT,ANSUNIT,ANSROOM,ANSBED)=""

 +2        SET (ANSPUNIT,ANSPROOM,ANSPBED)=0

 +3        IF '$DATA(^DPT(ANSX,0))

               QUIT 

 +4        SET ANSINPT=$PIECE(^DPT(ANSX,0),U)

 +5        SET ANSY=$ORDER(^ANSR("PT",ANSX,""))

 +6        IF 'ANSY

               QUIT 

 +7        IF '$DATA(^ANSR(ANSY,0))!'$DATA(^("DX"))

               QUIT 

 +8        SET ANSPUNIT=$PIECE(^ANSR(ANSY,"DX"),U,2)

           SET ANSUNIT=$SELECT(ANSPUNIT:^ANSD(59.1,ANSPUNIT,0),1:"NOT SPECIFIED")

 +9        SET ANSPROOM=$PIECE(^ANSR(ANSY,"DX"),U,3)

           SET ANSROOM=$SELECT(ANSPUNIT&ANSPROOM:^ANSD(59.1,ANSPUNIT,"R",ANSPROOM,0),1:"UNK")

 +10       SET ANSBED=$SELECT(ANSPUNIT&ANSPROOM&($PIECE(^ANSR(ANSY,"DX"),U,4)):^ANSD(59.1,ANSPUNIT,"R",ANSPROOM,"B",$PIECE(^ANSR(ANSY,"DX"),U,4),0),1:"UNK")

 +11       DO CURASS

 +12       SET ^TMP("ANSPA",$JOB,ANSINPT,ANSUNIT,ANSROOM,ANSBED,ANSCADT)=""

 +13       QUIT 

INPAT     ;PRINT INPATIENT ARRAY HEADING

 +1        WRITE !!,?5,"You may choose one of the following inpatients:"

 +2        WRITE !,"================================================================================"

 +3        WRITE !,"LAST ASSESS",!,"DATE",?7,"SHFT",?17,"NAME",?50,"UNIT",?67,"ROOM",?77,"BED"

 +4        WRITE !,"-----  ----",?13,"-----------------------------------",?50,"---------------",?67,"--------",?77,"---"

 +5        SET ANSZ=0

           SET (ANSINPT,ANSUNIT,ANSROOM,ANSBED,ANSCADT)=""

 +6        FOR 

               SET ANSINPT=$ORDER(^TMP("ANSPA",$JOB,ANSINPT))

               IF ANSINPT=""!$DATA(DUOUT)

                   QUIT 

               DO PARRAY

 +7        QUIT 

PARRAY    ;SET PRINT ARRAY VARIALBES

 +1        SET (ANSUNIT,ANSROOM,ANSBED,ANSCADT)=""

 +2        SET ANSUNIT=$ORDER(^TMP("ANSPA",$JOB,ANSINPT,ANSUNIT))

 +3        IF ANSUNIT

               SET ANSROOM=$ORDER(^TMP("ANSPA",$JOB,ANSINPT,ANSUNIT,ANSROOM))

 +4        IF ANSROOM

               SET ANSBED=$ORDER(^TMP("ANSPA",$JOB,ANSINPT,ANSUNIT,ANSROOM,ANSBED))

 +5        IF ANSBED

               SET ANSCADT=$ORDER(^TMP("ANSPA",$JOB,ANSINPT,ANSUNIT,ANSROOM,ANSBED,ANSCADT))

 +6        SET ANSZ=ANSZ+1

 +7        IF '$DATA(DUOUT)

               DO LIST

 +8        QUIT 

LIST      ;PRINT LIST OF INPATIENTS

 +1        IF ANSCADT["NONE"

               WRITE !,"NONE"

 +2       IF '$TEST

               WRITE !,$EXTRACT(ANSCADT,4,5)_"-"_$EXTRACT(ANSCADT,6,7),?9,$PIECE(ANSCADT,".",2)

 +3        WRITE ?13,$EXTRACT(ANSINPT,1,35),?50,ANSUNIT,?67,ANSROOM,?77,ANSBED

 +4        IF ANSZ>17

               DO LIST1

 +5        QUIT 

LIST1      IF ANSINPT]""

               Begin DoDot:1

 +1                WRITE !!,?10,"There are additional inpatients."

 +2                DO PAUSE^ANSDIC

                   SET ANSZ=0

               End DoDot:1

 +3        QUIT 

CURASS    ;FIND DATE AND SHIFT OF MOST RECENT ASSESSMENT

 +1        SET (ANSCA,ANSCADT)=""

           SET (AST,AST1)=0

 +2        IF '$DATA(^ANSR(ANSY,"AT"))

               SET ANSCADT="   NONE"

               QUIT 

 +3        FOR 

               SET ANSCA=$ORDER(^ANSR(ANSY,"AT",ANSCA))

               IF ANSCA=""

                   QUIT 

               SET AST=AST+1

 +4        DO ANSCADT

 +5        QUIT 

ANSCADT    FOR I=0:1:AST-1

               SET ANSCADT=$ORDER(^ANSR(ANSY,"AT",ANSCADT))

 +1        QUIT 

MSG       ;EP;

 +1        SET ANSCOUNT=1

           SET DIR(0)="YO"

           SET DIR("A")="Do you want to see a list of current inpatients"

           SET DIR("B")="NO"

 +2        WRITE !

 +3        DO DIR^ANSDIC

 +4        IF $DATA(DTOUT)!$DATA(DUOUT)!($GET(Y)'=1)

               QUIT 

 +5        DO INPATAR

 +6        KILL ^TMP("ANSPA",$JOB),ANSX,ANSINPT,ANSUNIT,ANSROOM,ANSBED,ANSPUNIT,ANSPROOM,ANSPBED,ANSZ

 +7        QUIT