Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: NURCEVE0

NURCEVE0.m

Go to the documentation of this file.
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