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