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
