source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURCEVE0.m@ 1013

Last change on this file since 1013 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 4.3 KB
Line 
1NURCEVE0 ;HIRMFO/RTK,RM-Nursing Care Plans Edit Report ;8/29/96
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3ENT1 ;
4 S NUROUT=0,GMRGRT=$O(^GMRD(124.2,"AA","NURSC",2,"Nursing Care Plan",""))
5 S:+GMRGRT>0 GMRGRT=GMRGRT_"^"_$P($G(^GMRD(124.2,+GMRGRT,0)),"^")
6 S:+GMRGRT'>0 NUROUT=1
7 I NUROUT W !,$C(7),"THERE IS A PROBLEM IN THE ""AA"" XREF.",!
8 E F S DIC="^DPT(",DIC(0)="AEQM" D ^DIC Q:+Y'>0 S (NCPDFN,DFN)=+Y D Q:NUROUT
9 . K ^TMP("NURPRB",$J),^TMP("NURCHC",$J)
10 . 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))
11 . . S NURSCPE=$O(^NURSC(216.8,"B",GMRGPDA,0)) I NURSCPE'>0 Q
12 . . 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)
13 . . S NURPROC=$$GETPRB^NURCEVE1(NURSCPE),NURACM=$S(NURPROC:1,1:NURACM)
14 . . Q
15 . F D Q:NURPROC<1
16 . . K ^TMP("NURPRB",$J),^TMP("NURCHC",$J),GMRGPDAA
17 . . 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))
18 . . . S NURSCPE=$O(^NURSC(216.8,"B",GMRGPDA,0)) I NURSCPE'>0 Q
19 . . . 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)
20 . . . S NURPROC=$$GETPRB^NURCEVE1(NURSCPE),NURACM=$S(NURPROC:1,1:NURACM)
21 . . . Q
22 . . S NURPROC=$$PCKPROB^NURCEVE1($$SRTPROB^NURCEVE1(NURACM))
23 . . I NURPROC<1 S:NURPROC=-1 NUROUT=1 Q
24 . . F NLPVAR=0:0 S NLPVAR=$O(^TMP("NURUSL",$J,NLPVAR)) Q:NLPVAR'>0 D NEDT
25 . . W ! K DIR S DIR(0)="Y",DIR("A")="DO YOU WANT TO PRINT A CARE PLAN",DIR("B")="YES" D ^DIR
26 . . I Y=1 D EN1^NURCEVE5
27 . . 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)),"^")
28 . . Q
29 . W !!!
30 . Q
31END ; CLEAN UP VARIABLES
32 K ^TMP($J),^TMP("NURCHC",$J) F X="NURUSL","NURPRB" K ^TMP(X,$J)
33 D ^NURCKILL
34 Q
35NEDT ; EDIT THE DATA FOR A PARTICULAR NURSING PROBLEM
36 S NURCX=$G(^TMP("NURCHC",$J,NLPVAR\1)),GMRGPDA=$P(NURCX,U,4),NURSCPE=$O(^NURSC(216.8,"B",GMRGPDA,0)),MATCH=0
37 F X=0:0 S X=$O(GMRGPDAA(X)) Q:X'>0 D
38 . I GMRGPDAA(X)=GMRGPDA S MATCH=1
39 . Q
40 S:MATCH=0 GMRGPDAA(GMRGPDA)=GMRGPDA
41 K NURCGOEX,NURCINT
42 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
43 S NURCGOEX=$O(^GMRD(124.25,"AA","NURSC","GOALS/EXPECTED OUTCOMES","")),NURCINT=$O(^GMRD(124.25,"AA","NURSC","NURSING INTERVENTION",""))
44 S NURCGL=$O(^GMRD(124.25,"AA","NURSC","GOAL","")),NURCORD=$O(^GMRD(124.25,"AA","NURSC","ORDERABLE",""))
45 K ^TMP("NURGOAL",$J),^TMP("NURINT",$J) D RECUR(+NURCX)
46 S:'$D(NURCGOEX(0)) NURCGOEX(0)="" S:'$D(NURCINT(0)) NURCINT(0)=""
47 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
48 D:NCPFLG GOALS^NURCEVE2
49 D:'NUROUT&(NCPFLG) ORDERS^NURCEVE3
50 F X="NURGOAL","NURINT" K ^TMP(X,$J)
51 K GMRGTERM,NURCGL,NURCGOEX,NURCINT,NURCORD,NURCX
52 Q
53RECUR(NURCX) ; GIVEN AN AGGREGATE TERM (NURCX) THIS PROCESS WILL LOOP THROUGH
54 ; ALL OF ITS CHILDREN AND PUT ALL GOALS IN ^TMP("NURGOAL",$J, ALL
55 ; INTERVENTIONS IN ^TMP("NURINT",$J. THEN THIS PROCEDURE WILL CALL
56 ; ITSELF RECURSIVELY FOR EACH CHILD
57 N NURCY,NURCZ
58 F NURCY=0:0 S NURCY=$O(^GMRD(124.2,NURCX,1,NURCY)) Q:NURCY'>0 D
59 . S NURCZ=+$G(^GMRD(124.2,NURCX,1,NURCY,0)) Q:NURCZ'>0
60 . S X=$G(^GMRD(124.2,NURCZ,0)),Y=$S($P(X,U,4)=NURCGL:"NURGOAL",$P(X,U,4)=NURCORD:"NURINT",1:"")
61 . I $P(X,U,4)=NURCGOEX,'$D(NURCGOEX(0)) S NURCGOEX(0)=NURCZ_U_$P(X,U)
62 . I $P(X,U,4)=NURCINT,'$D(NURCINT(0)) S NURCINT(0)=NURCZ_U_$P(X,U)
63 . 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)
64 . Q
65 Q
66SET(A,B) ; GIVEN AGGY IEN (A) AND ZEROTH NODE (B) AND PLAN IN GMRGPDA,
67 ; THIS FUNCTION RETURNS A_"^"_$P(B,U)_"^"_(ENTRY IN 124.31)
68 Q A_"^"_$P(B,U)_"^"_$O(^GMR(124.3,GMRGPDA,1,"B",A,0))
69 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
Note: See TracBrowser for help on using the repository browser.