Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: NURACEW1

NURACEW1.m

Go to the documentation of this file.
  1. NURACEW1 ;HIRMFO/RM-CHECK FOR PATIENTS NOT CLASSIFIED BY WARD...cont. ;MAY 1985
  1. ;;4.0;NURSING SERVICE;;Apr 25, 1997
  1. EN1 ; ENTRY FROM NURACEW0, ASK TO CLASSIFY THOSE NOT CLASSIFIED TODAY
  1. G:('$D(NURSTABL(1))) QUIT2
  1. D SORTTABL S NURQUIT=0 F TCNT=1:1 D:$D(NURSTABL(TCNT))&'NURQUIT CHKCONT1 Q:'$D(NURSTABL(TCNT))!NURQUIT
  1. G QUIT2
  1. CHKCONT1 ;
  1. W !!,$P(NURSTABL(TCNT),"^",2),?$X+10,ROOMTABL(TCNT)," OK" S %=1 D YN^DICN
  1. I %=-1 S NURQUIT=1 Q
  1. I %=1 S TABLSW=0 D EN1^NURACE0 Q
  1. I %=2 D CHKCONT2 Q
  1. W !,"ANSWER YES OR NO" G CHKCONT1
  1. CHKCONT2 ;
  1. W !!,"Do you wish to stop looping through names" S %=1 D YN^DICN
  1. I %=-1!(%=1) S NURQUIT=1 Q
  1. Q:%=2
  1. W !,"ANSWER YES OR NO" G CHKCONT2
  1. QUIT2 ; KILL REST OF VARIABLES USED IN ROUTINE
  1. I $D(NURSTABL(1))&'PRTSW W !!,?16,"**** ROUTINE FINISHED ****",!!
  1. K %,NS1,NURSA,NURSTABL,NURSTRAN,NURSX,TABLSW,TCNT
  1. Q
  1. SORTTABL ; THIS PUTS THE ARRAYS IN ORDER BY ROOM-BED (IF EXIST) OR NAME
  1. K ^TMP($J) S NURSDTSW=0 S:$D(DATETABL) NURSDTSW=1
  1. F NURSZ=1:1:NURSCNT D SETSORT
  1. S NURSX=0,NURSZ="" F NURSA=0:0 S NURSZ=$O(^TMP($J,NURSZ)) Q:NURSZ="" S NURSY="" F NURSA=0:0 S NURSY=$O(^TMP($J,NURSZ,NURSY)) Q:NURSY="" F DFN=0:0 S DFN=$O(^TMP($J,NURSZ,NURSY,DFN)) Q:DFN'>0 S NURSX=NURSX+1 D RESETARR
  1. Q K ^TMP($J) Q
  1. RESETARR ;
  1. S ROOMTABL(NURSX)=$S(NURSZ'=" EMPTY":NURSZ,1:"")
  1. S NURSTABL(NURSX)=DFN_"^"_NURSY
  1. S:NURSDTSW DATETABL(NURSX)=^TMP($J,NURSZ,NURSY,+NURSTABL(NURSX))
  1. Q
  1. SETSORT ;
  1. Q:'$D(NURSTABL(NURSZ))!($P(NURSTABL(NURSZ),"^",2)="") S NURSWHO=$P(NURSTABL(NURSZ),"^",2)
  1. S ^TMP($J,$S(ROOMTABL(NURSZ)'="":ROOMTABL(NURSZ),1:" EMPTY"),NURSWHO,+NURSTABL(NURSZ))=$S('NURSDTSW:"",1:DATETABL(NURSZ))
  1. Q