70 lines
4.3 KiB
Mathematica
70 lines
4.3 KiB
Mathematica
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
|