NURCES1.m

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 ---NURCES1   1719     printed  Apr 09, 2024@21:23:19                                                                                                                                                                                                     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