NURCEVE0 ;HIRMFO/RTK,RM-Nursing Care Plans Edit Report ;8/29/96
;;4.0;NURSING SERVICE;;Apr 25, 1997
ENT1 ;
S NUROUT=0,GMRGRT=$O(^GMRD(124.2,"AA","NURSC",2,"Nursing Care Plan",""))
S:+GMRGRT>0 GMRGRT=GMRGRT_"^"_$P($G(^GMRD(124.2,+GMRGRT,0)),"^")
S:+GMRGRT'>0 NUROUT=1
I NUROUT W !,$C(7),"THERE IS A PROBLEM IN THE ""AA"" XREF.",!
E F S DIC="^DPT(",DIC(0)="AEQM" D ^DIC Q:+Y'>0 S (NCPDFN,DFN)=+Y D Q:NUROUT
. K ^TMP("NURPRB",$J),^TMP("NURCHC",$J)
. S NURACM=0 F REVDT=0:0 S REVDT=$O(^GMR(124.3,"AA",DFN,+GMRGRT,REVDT)) Q:REVDT'>0 F GMRGPDA=0:0 S GMRGPDA=$O(^GMR(124.3,"AA",DFN,+GMRGRT,REVDT,GMRGPDA)) Q:GMRGPDA'>0 D:'+$G(^GMR(124.3,GMRGPDA,5))
. . S NURSCPE=$O(^NURSC(216.8,"B",GMRGPDA,0)) I NURSCPE'>0 Q
. . S Y=$P($G(^GMR(124.3,GMRGPDA,0)),U,3),DEVDT=9999999.9999-Y D D^DIQ S NURCPDT(GMRGPDA)=DEVDT_"^"_$E(Y,1,18)
. . S NURPROC=$$GETPRB^NURCEVE1(NURSCPE),NURACM=$S(NURPROC:1,1:NURACM)
. . Q
. F D Q:NURPROC<1
. . K ^TMP("NURPRB",$J),^TMP("NURCHC",$J),GMRGPDAA
. . S NURACM=0 F REVDT=0:0 S REVDT=$O(^GMR(124.3,"AA",DFN,+GMRGRT,REVDT)) Q:REVDT'>0 F GMRGPDA=0:0 S GMRGPDA=$O(^GMR(124.3,"AA",DFN,+GMRGRT,REVDT,GMRGPDA)) Q:GMRGPDA'>0 D:'+$G(^GMR(124.3,GMRGPDA,5))
. . . S NURSCPE=$O(^NURSC(216.8,"B",GMRGPDA,0)) I NURSCPE'>0 Q
. . . S Y=$P($G(^GMR(124.3,GMRGPDA,0)),U,3),DEVDT=9999999.9999-Y D D^DIQ S NURCPDT(GMRGPDA)=DEVDT_"^"_$E(Y,1,18)
. . . S NURPROC=$$GETPRB^NURCEVE1(NURSCPE),NURACM=$S(NURPROC:1,1:NURACM)
. . . Q
. . S NURPROC=$$PCKPROB^NURCEVE1($$SRTPROB^NURCEVE1(NURACM))
. . I NURPROC<1 S:NURPROC=-1 NUROUT=1 Q
. . F NLPVAR=0:0 S NLPVAR=$O(^TMP("NURUSL",$J,NLPVAR)) Q:NLPVAR'>0 D NEDT
. . W ! K DIR S DIR(0)="Y",DIR("A")="DO YOU WANT TO PRINT A CARE PLAN",DIR("B")="YES" D ^DIR
. . I Y=1 D EN1^NURCEVE5
. . S DFN=NCPDFN,GMRGRT=$O(^GMRD(124.2,"AA","NURSC",2,"Nursing Care Plan","")) S:+GMRGRT>0 GMRGRT=GMRGRT_"^"_$P($G(^GMRD(124.2,+GMRGRT,0)),"^")
. . Q
. W !!!
. Q
END ; CLEAN UP VARIABLES
K ^TMP($J),^TMP("NURCHC",$J) F X="NURUSL","NURPRB" K ^TMP(X,$J)
D ^NURCKILL
Q
NEDT ; EDIT THE DATA FOR A PARTICULAR NURSING PROBLEM
S NURCX=$G(^TMP("NURCHC",$J,NLPVAR\1)),GMRGPDA=$P(NURCX,U,4),NURSCPE=$O(^NURSC(216.8,"B",GMRGPDA,0)),MATCH=0
F X=0:0 S X=$O(GMRGPDAA(X)) Q:X'>0 D
. I GMRGPDAA(X)=GMRGPDA S MATCH=1
. Q
S:MATCH=0 GMRGPDAA(GMRGPDA)=GMRGPDA
K NURCGOEX,NURCINT
S GMRGXPRT=$P(NURCX,U,2),GMRGPDA=$P(NURCX,U,4),GMRGXPRT(0)=$$SELDAT^NURCEVE2(+NURCX,GMRGPDA),GMRGXPRT(1)="^^1^^1" D EN1^GMRGRUT2 W !,GMRGXPRT
S NURCGOEX=$O(^GMRD(124.25,"AA","NURSC","GOALS/EXPECTED OUTCOMES","")),NURCINT=$O(^GMRD(124.25,"AA","NURSC","NURSING INTERVENTION",""))
S NURCGL=$O(^GMRD(124.25,"AA","NURSC","GOAL","")),NURCORD=$O(^GMRD(124.25,"AA","NURSC","ORDERABLE",""))
K ^TMP("NURGOAL",$J),^TMP("NURINT",$J) D RECUR(+NURCX)
S:'$D(NURCGOEX(0)) NURCGOEX(0)="" S:'$D(NURCINT(0)) NURCINT(0)=""
I 'NUROUT S GMRGOUT=0,GMRGTERM=$P(NURCX,U,1,2)_U_$O(^GMR(124.3,GMRGPDA,1,"B",+NURCX,"")),GMRGXPRT=$P(NURCX,U,2),GMRGXPRT(0)=$$SELDAT^NURCEVE2(+NURCX,GMRGPDA),GMRGXPRT(1)="^^1^^1",NCPFLG=1 D EN2^NURCCPU3
D:NCPFLG GOALS^NURCEVE2
D:'NUROUT&(NCPFLG) ORDERS^NURCEVE3
F X="NURGOAL","NURINT" K ^TMP(X,$J)
K GMRGTERM,NURCGL,NURCGOEX,NURCINT,NURCORD,NURCX
Q
RECUR(NURCX) ; GIVEN AN AGGREGATE TERM (NURCX) THIS PROCESS WILL LOOP THROUGH
; ALL OF ITS CHILDREN AND PUT ALL GOALS IN ^TMP("NURGOAL",$J, ALL
; INTERVENTIONS IN ^TMP("NURINT",$J. THEN THIS PROCEDURE WILL CALL
; ITSELF RECURSIVELY FOR EACH CHILD
N NURCY,NURCZ
F NURCY=0:0 S NURCY=$O(^GMRD(124.2,NURCX,1,NURCY)) Q:NURCY'>0 D
. S NURCZ=+$G(^GMRD(124.2,NURCX,1,NURCY,0)) Q:NURCZ'>0
. S X=$G(^GMRD(124.2,NURCZ,0)),Y=$S($P(X,U,4)=NURCGL:"NURGOAL",$P(X,U,4)=NURCORD:"NURINT",1:"")
. I $P(X,U,4)=NURCGOEX,'$D(NURCGOEX(0)) S NURCGOEX(0)=NURCZ_U_$P(X,U)
. I $P(X,U,4)=NURCINT,'$D(NURCINT(0)) S NURCINT(0)=NURCZ_U_$P(X,U)
. I $$ACTIVE^NURCEVE2(GMRGPDA,NURCZ) S:Y'="" ^TMP(Y,$J,$P(X,U),NURCZ)=X S:$P(X,U,4)=NURCGOEX NURCGOEX(0)=$$SET(NURCZ,X) S:$P(X,U,4)=NURCINT NURCINT(0)=$$SET(NURCZ,X) D RECUR(NURCZ)
. Q
Q
SET(A,B) ; GIVEN AGGY IEN (A) AND ZEROTH NODE (B) AND PLAN IN GMRGPDA,
; THIS FUNCTION RETURNS A_"^"_$P(B,U)_"^"_(ENTRY IN 124.31)
Q A_"^"_$P(B,U)_"^"_$O(^GMR(124.3,GMRGPDA,1,"B",A,0))
I Y=1 S GMRGXPRT="1^0^0" D EN1^GMRGRUT3 S:GMRGOUT NUROUT=1 K GMRGOUT,GMRGXPRT I 'NUROUT S (NURSOUT,NURSGMRG)=0,NUREDB="P" D REASK^NURCPPS1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCEVE0 4491 printed Dec 13, 2024@02:20:26 Page 2
NURCEVE0 ;HIRMFO/RTK,RM-Nursing Care Plans Edit Report ;8/29/96
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
ENT1 ;
+1 SET NUROUT=0
SET GMRGRT=$ORDER(^GMRD(124.2,"AA","NURSC",2,"Nursing Care Plan",""))
+2 if +GMRGRT>0
SET GMRGRT=GMRGRT_"^"_$PIECE($GET(^GMRD(124.2,+GMRGRT,0)),"^")
+3 if +GMRGRT'>0
SET NUROUT=1
+4 IF NUROUT
WRITE !,$CHAR(7),"THERE IS A PROBLEM IN THE ""AA"" XREF.",!
+5 IF '$TEST
FOR
SET DIC="^DPT("
SET DIC(0)="AEQM"
DO ^DIC
if +Y'>0
QUIT
SET (NCPDFN,DFN)=+Y
Begin DoDot:1
+6 KILL ^TMP("NURPRB",$JOB),^TMP("NURCHC",$JOB)
+7 SET NURACM=0
FOR REVDT=0:0
SET REVDT=$ORDER(^GMR(124.3,"AA",DFN,+GMRGRT,REVDT))
if REVDT'>0
QUIT
FOR GMRGPDA=0:0
SET GMRGPDA=$ORDER(^GMR(124.3,"AA",DFN,+GMRGRT,REVDT,GMRGPDA))
if GMRGPDA'>0
QUIT
if '+$GET(^GMR(124.3,GMRGPDA,5))
Begin DoDot:2
+8 SET NURSCPE=$ORDER(^NURSC(216.8,"B",GMRGPDA,0))
IF NURSCPE'>0
QUIT
+9 SET Y=$PIECE($GET(^GMR(124.3,GMRGPDA,0)),U,3)
SET DEVDT=9999999.9999-Y
DO D^DIQ
SET NURCPDT(GMRGPDA)=DEVDT_"^"_$EXTRACT(Y,1,18)
+10 SET NURPROC=$$GETPRB^NURCEVE1(NURSCPE)
SET NURACM=$SELECT(NURPROC:1,1:NURACM)
+11 QUIT
End DoDot:2
+12 FOR
Begin DoDot:2
+13 KILL ^TMP("NURPRB",$JOB),^TMP("NURCHC",$JOB),GMRGPDAA
+14 SET NURACM=0
FOR REVDT=0:0
SET REVDT=$ORDER(^GMR(124.3,"AA",DFN,+GMRGRT,REVDT))
if REVDT'>0
QUIT
FOR GMRGPDA=0:0
SET GMRGPDA=$ORDER(^GMR(124.3,"AA",DFN,+GMRGRT,REVDT,GMRGPDA))
if GMRGPDA'>0
QUIT
if '+$GET(^GMR(124.3,GMRGPDA,5))
Begin DoDot:3
+15 SET NURSCPE=$ORDER(^NURSC(216.8,"B",GMRGPDA,0))
IF NURSCPE'>0
QUIT
+16 SET Y=$PIECE($GET(^GMR(124.3,GMRGPDA,0)),U,3)
SET DEVDT=9999999.9999-Y
DO D^DIQ
SET NURCPDT(GMRGPDA)=DEVDT_"^"_$EXTRACT(Y,1,18)
+17 SET NURPROC=$$GETPRB^NURCEVE1(NURSCPE)
SET NURACM=$SELECT(NURPROC:1,1:NURACM)
+18 QUIT
End DoDot:3
+19 SET NURPROC=$$PCKPROB^NURCEVE1($$SRTPROB^NURCEVE1(NURACM))
+20 IF NURPROC<1
if NURPROC=-1
SET NUROUT=1
QUIT
+21 FOR NLPVAR=0:0
SET NLPVAR=$ORDER(^TMP("NURUSL",$JOB,NLPVAR))
if NLPVAR'>0
QUIT
DO NEDT
+22 WRITE !
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="DO YOU WANT TO PRINT A CARE PLAN"
SET DIR("B")="YES"
DO ^DIR
+23 IF Y=1
DO EN1^NURCEVE5
+24 SET DFN=NCPDFN
SET GMRGRT=$ORDER(^GMRD(124.2,"AA","NURSC",2,"Nursing Care Plan",""))
if +GMRGRT>0
SET GMRGRT=GMRGRT_"^"_$PIECE($GET(^GMRD(124.2,+GMRGRT,0)),"^")
+25 QUIT
End DoDot:2
if NURPROC<1
QUIT
+26 WRITE !!!
+27 QUIT
End DoDot:1
if NUROUT
QUIT
END ; CLEAN UP VARIABLES
+1 KILL ^TMP($JOB),^TMP("NURCHC",$JOB)
FOR X="NURUSL","NURPRB"
KILL ^TMP(X,$JOB)
+2 DO ^NURCKILL
+3 QUIT
NEDT ; EDIT THE DATA FOR A PARTICULAR NURSING PROBLEM
+1 SET NURCX=$GET(^TMP("NURCHC",$JOB,NLPVAR\1))
SET GMRGPDA=$PIECE(NURCX,U,4)
SET NURSCPE=$ORDER(^NURSC(216.8,"B",GMRGPDA,0))
SET MATCH=0
+2 FOR X=0:0
SET X=$ORDER(GMRGPDAA(X))
if X'>0
QUIT
Begin DoDot:1
+3 IF GMRGPDAA(X)=GMRGPDA
SET MATCH=1
+4 QUIT
End DoDot:1
+5 if MATCH=0
SET GMRGPDAA(GMRGPDA)=GMRGPDA
+6 KILL NURCGOEX,NURCINT
+7 SET GMRGXPRT=$PIECE(NURCX,U,2)
SET GMRGPDA=$PIECE(NURCX,U,4)
SET GMRGXPRT(0)=$$SELDAT^NURCEVE2(+NURCX,GMRGPDA)
SET GMRGXPRT(1)="^^1^^1"
DO EN1^GMRGRUT2
WRITE !,GMRGXPRT
+8 SET NURCGOEX=$ORDER(^GMRD(124.25,"AA","NURSC","GOALS/EXPECTED OUTCOMES",""))
SET NURCINT=$ORDER(^GMRD(124.25,"AA","NURSC","NURSING INTERVENTION",""))
+9 SET NURCGL=$ORDER(^GMRD(124.25,"AA","NURSC","GOAL",""))
SET NURCORD=$ORDER(^GMRD(124.25,"AA","NURSC","ORDERABLE",""))
+10 KILL ^TMP("NURGOAL",$JOB),^TMP("NURINT",$JOB)
DO RECUR(+NURCX)
+11 if '$DATA(NURCGOEX(0))
SET NURCGOEX(0)=""
if '$DATA(NURCINT(0))
SET NURCINT(0)=""
+12 IF 'NUROUT
SET GMRGOUT=0
SET GMRGTERM=$PIECE(NURCX,U,1,2)_U_$ORDER(^GMR(124.3,GMRGPDA,1,"B",+NURCX,""))
SET GMRGXPRT=$PIECE(NURCX,U,2)
SET GMRGXPRT(0)=$$SELDAT^NURCEVE2(+NURCX,GMRGPDA)
SET GMRGXPRT(1)="^^1^^1"
SET NCPFLG=1
DO EN2^NURCCPU3
+13 if NCPFLG
DO GOALS^NURCEVE2
+14 if 'NUROUT&(NCPFLG)
DO ORDERS^NURCEVE3
+15 FOR X="NURGOAL","NURINT"
KILL ^TMP(X,$JOB)
+16 KILL GMRGTERM,NURCGL,NURCGOEX,NURCINT,NURCORD,NURCX
+17 QUIT
RECUR(NURCX) ; GIVEN AN AGGREGATE TERM (NURCX) THIS PROCESS WILL LOOP THROUGH
+1 ; ALL OF ITS CHILDREN AND PUT ALL GOALS IN ^TMP("NURGOAL",$J, ALL
+2 ; INTERVENTIONS IN ^TMP("NURINT",$J. THEN THIS PROCEDURE WILL CALL
+3 ; ITSELF RECURSIVELY FOR EACH CHILD
+4 NEW NURCY,NURCZ
+5 FOR NURCY=0:0
SET NURCY=$ORDER(^GMRD(124.2,NURCX,1,NURCY))
if NURCY'>0
QUIT
Begin DoDot:1
+6 SET NURCZ=+$GET(^GMRD(124.2,NURCX,1,NURCY,0))
if NURCZ'>0
QUIT
+7 SET X=$GET(^GMRD(124.2,NURCZ,0))
SET Y=$SELECT($PIECE(X,U,4)=NURCGL:"NURGOAL",$PIECE(X,U,4)=NURCORD:"NURINT",1:"")
+8 IF $PIECE(X,U,4)=NURCGOEX
IF '$DATA(NURCGOEX(0))
SET NURCGOEX(0)=NURCZ_U_$PIECE(X,U)
+9 IF $PIECE(X,U,4)=NURCINT
IF '$DATA(NURCINT(0))
SET NURCINT(0)=NURCZ_U_$PIECE(X,U)
+10 IF $$ACTIVE^NURCEVE2(GMRGPDA,NURCZ)
if Y'=""
SET ^TMP(Y,$JOB,$PIECE(X,U),NURCZ)=X
if $PIECE(X,U,4)=NURCGOEX
SET NURCGOEX(0)=$$SET(NURCZ,X)
if $PIECE(X,U,4)=NURCINT
SET NURCINT(0)=$$SET(NURCZ,X)
DO RECUR(NURCZ)
+11 QUIT
End DoDot:1
+12 QUIT
SET(A,B) ; GIVEN AGGY IEN (A) AND ZEROTH NODE (B) AND PLAN IN GMRGPDA,
+1 ; THIS FUNCTION RETURNS A_"^"_$P(B,U)_"^"_(ENTRY IN 124.31)
+2 QUIT A_"^"_$PIECE(B,U)_"^"_$ORDER(^GMR(124.3,GMRGPDA,1,"B",A,0))
+3 IF Y=1
SET GMRGXPRT="1^0^0"
DO EN1^GMRGRUT3
if GMRGOUT
SET NUROUT=1
KILL GMRGOUT,GMRGXPRT
IF 'NUROUT
SET (NURSOUT,NURSGMRG)=0
SET NUREDB="P"
DO REASK^NURCPPS1
