- 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 Feb 18, 2025@23:46:51 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