NURCES1 ;HIRMFO/YH,MD,YH-END OF SHIFT REPORT PART 2 - NURSING CARE PROBLEM ;12/12/96
;;4.0;NURSING SERVICE;**42**;Apr 25, 1997;Build 3
PTPROB ;OBTAINS PATIENT'S PROBLEMS
S NPR=0,GMRGRT=$O(^GMRD(124.2,"AA","NURSC",2,"Nursing Care Plan",1,0)),GMRGPDA=0
F REVDAT=0:0 S REVDAT=$O(^GMR(124.3,"AA",DFN,GMRGRT,REVDAT)) Q:'REVDAT S GMRGPDA=$O(^GMR(124.3,"AA",DFN,GMRGRT,REVDAT,0)) I GMRGPDA Q:'$S('$D(^GMR(124.3,GMRGPDA,5)):0,1:+^(5)) S GMRGPDA=0
Q:'GMRGPDA S NURSCPE=+$O(^NURSC(216.8,"B",GMRGPDA,0))
K NURSPROB F PROB=0:0 S PROB=$O(^NURSC(216.8,NURSCPE,"EVAL","AA",PROB)) Q:PROB'>0 S REVDATE=+$O(^(PROB,0)),DA=+$O(^(REVDATE,0)) I $D(^NURSC(216.8,NURSCPE,"EVAL",DA,0)),'$P(^(0),"^",4) D PROB
S PSW=0,PSW(0)=1,PROB="" F NX=1:1 S PROB=$S(NX=1!(NX'=1&(PROB'="")&'PSW):$O(NURSPROB(PROB)),1:PROB) Q:PROB="" D FORMAT Q:NURQUIT
Q
PROB ;PATIENT PROBLEM ARRAY
I $D(^GMRD(124.2,PROB,0)),$P(^(0),"^")'="" S NURSPROB($P(^(0),"^"))=PROB
Q
FORMAT ;PATIENT PROBLEM
I 'PSW,PROB'="" S P=+$O(^GMR(124.3,GMRGPDA,1,"B",+NURSPROB(PROB),0)),GMRGXPRT=PROB,GMRGXPRT(0)=$S($D(^GMR(124.3,GMRGPDA,1,P,0)):$P(^(0),"^",2),1:""),GMRGXPRT(1)="^^0^^1" D EN1^GMRGRUT2 S PRPROB=GMRGXPRT,(PSW(0),PSW)=1
S LEN=62 I $D(PRPROB) S GMRGLEN=LEN,GMRGPLN=PRPROB D FITLINE^GMRGRUT1 S NURPLN=GMRGPLN(0),PRPROB=GMRGPLN(1) S:PRPROB="" PSW=0
I $D(PRORD) S GMRGLEN=LEN,GMRGPLN=PRORD D FITLINE^GMRGRUT1 S NURPLN(0)=GMRGPLN(0),PRORD=GMRGPLN(1)
;I ($Y>(IOSL-6)) D HEADER^NURCES2 Q:NURQUIT D HEADER1^NURCES2
S:($D(NURPLN)#2) NPR=NPR+1,NPR(NPR)=$S('PSW(0):" ",1:"")_NURPLN S PSW(0)=0
Q
VM ;EXTRACTS LATEST VITAL MEASUREMENTS AND ABNORMAL V/M FOR THE PAST 24 HOURS
D VITAL^NURCES5 K ^UTILITY($J,"GMRVD")
Q
SETDATAR ;
Q
SETNODE ;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCES1 1719 printed Nov 22, 2024@17:30:26 Page 2
NURCES1 ;HIRMFO/YH,MD,YH-END OF SHIFT REPORT PART 2 - NURSING CARE PROBLEM ;12/12/96
+1 ;;4.0;NURSING SERVICE;**42**;Apr 25, 1997;Build 3
PTPROB ;OBTAINS PATIENT'S PROBLEMS
+1 SET NPR=0
SET GMRGRT=$ORDER(^GMRD(124.2,"AA","NURSC",2,"Nursing Care Plan",1,0))
SET GMRGPDA=0
+2 FOR REVDAT=0:0
SET REVDAT=$ORDER(^GMR(124.3,"AA",DFN,GMRGRT,REVDAT))
if 'REVDAT
QUIT
SET GMRGPDA=$ORDER(^GMR(124.3,"AA",DFN,GMRGRT,REVDAT,0))
IF GMRGPDA
if '$SELECT('$DATA(^GMR(124.3,GMRGPDA,5))
QUIT
SET GMRGPDA=0
+3 if 'GMRGPDA
QUIT
SET NURSCPE=+$ORDER(^NURSC(216.8,"B",GMRGPDA,0))
+4 KILL NURSPROB
FOR PROB=0:0
SET PROB=$ORDER(^NURSC(216.8,NURSCPE,"EVAL","AA",PROB))
if PROB'>0
QUIT
SET REVDATE=+$ORDER(^(PROB,0))
SET DA=+$ORDER(^(REVDATE,0))
IF $DATA(^NURSC(216.8,NURSCPE,"EVAL",DA,0))
IF '$PIECE(^(0),"^",4)
DO PROB
+5 SET PSW=0
SET PSW(0)=1
SET PROB=""
FOR NX=1:1
SET PROB=$SELECT(NX=1!(NX'=1&(PROB'="")&'PSW):$ORDER(NURSPROB(PROB)),1:PROB)
if PROB=""
QUIT
DO FORMAT
if NURQUIT
QUIT
+6 QUIT
PROB ;PATIENT PROBLEM ARRAY
+1 IF $DATA(^GMRD(124.2,PROB,0))
IF $PIECE(^(0),"^")'=""
SET NURSPROB($PIECE(^(0),"^"))=PROB
+2 QUIT
FORMAT ;PATIENT PROBLEM
+1 IF 'PSW
IF PROB'=""
SET P=+$ORDER(^GMR(124.3,GMRGPDA,1,"B",+NURSPROB(PROB),0))
SET GMRGXPRT=PROB
SET GMRGXPRT(0)=$SELECT($DATA(^GMR(124.3,GMRGPDA,1,P,0)):$PIECE(^(0),"^",2),1:"")
SET GMRGXPRT(1)="^^0^^1"
DO EN1^GMRGRUT2
SET PRPROB=GMRGXPRT
SET (PSW(0),PSW)=1
+2 SET LEN=62
IF $DATA(PRPROB)
SET GMRGLEN=LEN
SET GMRGPLN=PRPROB
DO FITLINE^GMRGRUT1
SET NURPLN=GMRGPLN(0)
SET PRPROB=GMRGPLN(1)
if PRPROB=""
SET PSW=0
+3 IF $DATA(PRORD)
SET GMRGLEN=LEN
SET GMRGPLN=PRORD
DO FITLINE^GMRGRUT1
SET NURPLN(0)=GMRGPLN(0)
SET PRORD=GMRGPLN(1)
+4 ;I ($Y>(IOSL-6)) D HEADER^NURCES2 Q:NURQUIT D HEADER1^NURCES2
+5 if ($DATA(NURPLN)#2)
SET NPR=NPR+1
SET NPR(NPR)=$SELECT('PSW(0):" ",1:"")_NURPLN
SET PSW(0)=0
+6 QUIT
VM ;EXTRACTS LATEST VITAL MEASUREMENTS AND ABNORMAL V/M FOR THE PAST 24 HOURS
+1 DO VITAL^NURCES5
KILL ^UTILITY($JOB,"GMRVD")
+2 QUIT
SETDATAR ;
+1 QUIT
SETNODE ;
+1 QUIT
