NURCES5 ;HIRMFO/YH-END OF SHIFT -VITAL/MEASUREMENT DATA ;5/19/17
;;4.0;NURSING SERVICE;**24,45**;Apr 25, 1997;Build 12
VITAL ;
N NUR,NURVIT,NURIEF,NURDT,NDTFLG,NURDT,NURTYP,NURQUAL,NURDATA,NURWT,NURHT,NURBMI
S GMRVSTR="T;P;R;BP;WT;HT;PN;PO2;",GMRVSTR(0)="^^1^1" D EN1^GMRVUT0
I $D(^UTILITY($J,"GMRVD")) S %X="^UTILITY($J,""GMRVD"",",%Y="NURVIT(" D %XY^%RCR K ^UTILITY($J,"GMRVD")
S GMRVSTR="T;P;R;BP;PN;",GMRVSTR(0)=NURNOW(1)_"^"_NURNOW D EN1^GMRVUT0
F NUR="T","P","R","BP" S NURDT=0 F S NURDT=$O(^UTILITY($J,"GMRVD",NUR,NURDT)) Q:NURDT'>0 S NURDA=0 F S NURDA=$O(^UTILITY($J,"GMRVD",NUR,NURDT,NURDA)) Q:NURDA'>0 D
. I $P(^UTILITY($J,"GMRVD",NUR,NURDT,NURDA),"^",12)="*",'$D(NURVIT(NURDT,NUR,NURDA)) S NURVIT(NURDT,NUR,NURDA)=^UTILITY($J,"GMRVD",NUR,NURDT,NURDA)
K NVM S NVM=0 S NURDT=0,NDTFLG=0 F S NURDT=$O(NURVIT(NURDT)) Q:NURDT'>0 D
. I NURDT'=NDTFLG S NDTFLG=NURDT,NVM=NVM+1,NVM(NVM)=$$FMTE^XLFDT(9999999-NURDT,"2P"),NDTFLG=NURDT
. S NURTYP="" F S NURTYP=$O(NURVIT(NURDT,NURTYP)) Q:NURTYP="" D
. . S NURIEF=0 F S NURIEF=$O(NURVIT(NURDT,NURTYP,NURIEF)) Q:NURIEF'>0 D
. . . S NURDATA=NURVIT(NURDT,NURTYP,NURIEF)
. . . S NURQUAL=$P(NURDATA,"^",10)_$S($P(NURDATA,"^",10)'="":" ",1:"")_$P(NURDATA,"^",11)
. . . S:NURQUAL'="" NURQUAL="-"_NURQUAL
. . . S NURDATA(1)=$P(NURDATA,"^",8)_$P(NURDATA,"^",12)_$S(NURTYP="WT":" lb",NURTYP="HT":" in",1:"")_NURQUAL
. . . I '$D(NURTYP(NURDT,NURTYP)) S NVM=NVM+1,NVM(NVM)=$E(" "_NURTYP_":"_NURDATA(1),1,21),NURTYP(NURDT,NURTYP)=""
. . .E S NVM=NVM+1,NVM(NVM)=" "_$E(NURDATA(1),1,20)
. . . I NURTYP="WT" S NURWT=$S($P(NURDATA,"^",13)>0:+$P(NURDATA,"^",13),1:0)
. . . I NURTYP="HT" S NURHT=$S($P(NURDATA,"^",13)>0:$P(NURDATA,"^",13)/100,1:0)
. . . Q
. . Q
. Q
I $G(NURWT)>0,$G(NURHT)>0 S NURBMI=$J(NURWT/(NURHT*NURHT),0,0),NURBMI=NURBMI_$S(NURBMI>27:"*",1:""),NVM=NVM+1,NVM(NVM)="BMI: "_NURBMI
Q
SORT(NORDER) ;SORT BY ROOM-BED/ALPHABETICAL/BED
SORT1 W !,?5,"1. by room-bed",!,?5,"2. by alphabetical",!,?5,"3. by bed",!!,?5,"Enter a number: 1// " R NORDER:DTIME I '$T!(NORDER["^") S NURQUIT=1 Q NORDER
I NORDER="" S NORDER="SORT1" Q NORDER
I NORDER=1!(NORDER=2)!(NORDER=3) S NORDER="SORT"_NORDER Q NORDER
G SORT1
FITLINE(NLINE,NLEN,NGLOB) ;
N X,NL S X=NLINE,DIWR=NLEN,DIWF="",DIWL=0 K ^UTILITY($J) D ^DIWP
S NL=0 F S NL=$O(^UTILITY($J,"W",0,NL)) Q:NL'>0 S NGLOB=NGLOB+1,NGLOB(NGLOB)=$S(NL>1:" ",1:"")_^UTILITY($J,"W",0,NL,0)
K ^UTILITY($J)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCES5 2455 printed Apr 09, 2024@21:22:55 Page 2
NURCES5 ;HIRMFO/YH-END OF SHIFT -VITAL/MEASUREMENT DATA ;5/19/17
+1 ;;4.0;NURSING SERVICE;**24,45**;Apr 25, 1997;Build 12
VITAL ;
+1 NEW NUR,NURVIT,NURIEF,NURDT,NDTFLG,NURDT,NURTYP,NURQUAL,NURDATA,NURWT,NURHT,NURBMI
+2 SET GMRVSTR="T;P;R;BP;WT;HT;PN;PO2;"
SET GMRVSTR(0)="^^1^1"
DO EN1^GMRVUT0
+3 IF $DATA(^UTILITY($JOB,"GMRVD"))
SET %X="^UTILITY($J,""GMRVD"","
SET %Y="NURVIT("
DO %XY^%RCR
KILL ^UTILITY($JOB,"GMRVD")
+4 SET GMRVSTR="T;P;R;BP;PN;"
SET GMRVSTR(0)=NURNOW(1)_"^"_NURNOW
DO EN1^GMRVUT0
+5 FOR NUR="T","P","R","BP"
SET NURDT=0
FOR
SET NURDT=$ORDER(^UTILITY($JOB,"GMRVD",NUR,NURDT))
if NURDT'>0
QUIT
SET NURDA=0
FOR
SET NURDA=$ORDER(^UTILITY($JOB,"GMRVD",NUR,NURDT,NURDA))
if NURDA'>0
QUIT
Begin DoDot:1
+6 IF $PIECE(^UTILITY($JOB,"GMRVD",NUR,NURDT,NURDA),"^",12)="*"
IF '$DATA(NURVIT(NURDT,NUR,NURDA))
SET NURVIT(NURDT,NUR,NURDA)=^UTILITY($JOB,"GMRVD",NUR,NURDT,NURDA)
End DoDot:1
+7 KILL NVM
SET NVM=0
SET NURDT=0
SET NDTFLG=0
FOR
SET NURDT=$ORDER(NURVIT(NURDT))
if NURDT'>0
QUIT
Begin DoDot:1
+8 IF NURDT'=NDTFLG
SET NDTFLG=NURDT
SET NVM=NVM+1
SET NVM(NVM)=$$FMTE^XLFDT(9999999-NURDT,"2P")
SET NDTFLG=NURDT
+9 SET NURTYP=""
FOR
SET NURTYP=$ORDER(NURVIT(NURDT,NURTYP))
if NURTYP=""
QUIT
Begin DoDot:2
+10 SET NURIEF=0
FOR
SET NURIEF=$ORDER(NURVIT(NURDT,NURTYP,NURIEF))
if NURIEF'>0
QUIT
Begin DoDot:3
+11 SET NURDATA=NURVIT(NURDT,NURTYP,NURIEF)
+12 SET NURQUAL=$PIECE(NURDATA,"^",10)_$SELECT($PIECE(NURDATA,"^",10)'="":" ",1:"")_$PIECE(NURDATA,"^",11)
+13 if NURQUAL'=""
SET NURQUAL="-"_NURQUAL
+14 SET NURDATA(1)=$PIECE(NURDATA,"^",8)_$PIECE(NURDATA,"^",12)_$SELECT(NURTYP="WT":" lb",NURTYP="HT":" in",1:"")_NURQUAL
+15 IF '$DATA(NURTYP(NURDT,NURTYP))
SET NVM=NVM+1
SET NVM(NVM)=$EXTRACT(" "_NURTYP_":"_NURDATA(1),1,21)
SET NURTYP(NURDT,NURTYP)=""
+16 IF '$TEST
SET NVM=NVM+1
SET NVM(NVM)=" "_$EXTRACT(NURDATA(1),1,20)
+17 IF NURTYP="WT"
SET NURWT=$SELECT($PIECE(NURDATA,"^",13)>0:+$PIECE(NURDATA,"^",13),1:0)
+18 IF NURTYP="HT"
SET NURHT=$SELECT($PIECE(NURDATA,"^",13)>0:$PIECE(NURDATA,"^",13)/100,1:0)
+19 QUIT
End DoDot:3
+20 QUIT
End DoDot:2
+21 QUIT
End DoDot:1
+22 IF $GET(NURWT)>0
IF $GET(NURHT)>0
SET NURBMI=$JUSTIFY(NURWT/(NURHT*NURHT),0,0)
SET NURBMI=NURBMI_$SELECT(NURBMI>27:"*",1:"")
SET NVM=NVM+1
SET NVM(NVM)="BMI: "_NURBMI
+23 QUIT
SORT(NORDER) ;SORT BY ROOM-BED/ALPHABETICAL/BED
SORT1 WRITE !,?5,"1. by room-bed",!,?5,"2. by alphabetical",!,?5,"3. by bed",!!,?5,"Enter a number: 1// "
READ NORDER:DTIME
IF '$TEST!(NORDER["^")
SET NURQUIT=1
QUIT NORDER
+1 IF NORDER=""
SET NORDER="SORT1"
QUIT NORDER
+2 IF NORDER=1!(NORDER=2)!(NORDER=3)
SET NORDER="SORT"_NORDER
QUIT NORDER
+3 GOTO SORT1
FITLINE(NLINE,NLEN,NGLOB) ;
+1 NEW X,NL
SET X=NLINE
SET DIWR=NLEN
SET DIWF=""
SET DIWL=0
KILL ^UTILITY($JOB)
DO ^DIWP
+2 SET NL=0
FOR
SET NL=$ORDER(^UTILITY($JOB,"W",0,NL))
if NL'>0
QUIT
SET NGLOB=NGLOB+1
SET NGLOB(NGLOB)=$SELECT(NL>1:" ",1:"")_^UTILITY($JOB,"W",0,NL,0)
+3 KILL ^UTILITY($JOB)
+4 QUIT
