- NURCCPU5 ;HIRMFO/RD/RM-NURSING CARE PLAN UTILITIES (cont.) ;8/29/96
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- DCINT ; DC ALL INTERVENTIONS UNDER A PROBLEM
- S NURSORD=+$O(^GMRD(124.25,"AA","NURSC","ORDERABLE",0)),NURSINT=+$O(^GMRD(124.25,"AA","NURSC","NURSING INTERVENTION",0)),NURSPROB=+$O(^GMRD(124.25,"AA","NURSC","NURSING PROBLEM",0))
- F X=0:0 S X=$O(^GMRD(124.2,+GMRGTERM,1,"B",X)) Q:X'>0 S Y=$G(^GMRD(124.2,X,0)) I $P(Y,"^",4)=NURSINT D PRCINT(X)
- Q
- PRCINT(DA) ; STEP THROUGH CHILDREN OF X IF CHILD ORDERABLE THEN DC IF IN NCP
- N X
- F X=0:0 S X=$O(^GMRD(124.2,DA,1,"B",X)) Q:X'>0 S Y=$G(^GMRD(124.2,X,0)) D PRC
- Q
- PRC ; IF Y IS ORDERABLE THEN DC IF IN NCP, ELSE RECURSIVELY CALL PRCINT
- I $P(Y,"^",4)=NURSORD S NURSI=+$O(^NURSC(216.8,NURSCPE,"ORD","AA",X,0)),NURSJ=+$O(^(NURSI,0)),Y=$G(^NURSC(216.8,NURSCPE,"ORD",NURSJ,0)) D DC:Y]""&($P(Y,"^",3)'=1) Q
- D PRCINT(X)
- Q
- DC ; DC AN ORDER
- Q:'$$DCOK(X) S Y=X N DA,X
- S DA(1)=NURSCPE,NURSZN=$P(^NURSC(216.8,NURSCPE,"ORD",0),"^",3,4),DA=$P(NURSZN,"^",1)+1,NURSNUM=$P(NURSZN,"^",2) F DA=DA:1 Q:'$D(^NURSC(216.8,NURSCPE,"ORD",DA,0))
- S $P(^NURSC(216.8,DA(1),"ORD",0),"^",3,4)=DA_"^"_(NURSNUM+1),^NURSC(216.8,DA(1),"ORD",DA,0)=NURSNWDT_"^"_Y_"^1^"_DUZ
- S DIK="^NURSC(216.8,DA(1),""ORD""," D IX1^DIK
- Q
- DCOK(X) ; ARE ALL PROBLEMS UNDER WHICH AGGY TERM WITH IEN X LIES RESOLVED
- ; THIS FUNCTION RETURNS 1 IF THIS STATEMENT IS TRUE, ELSE 0.
- N Y,Z,OK
- S OK=1 F Y=0:0 S Y=$O(^GMRD(124.2,"AKID",X,Y)) Q:Y'>0 S Z=$G(^GMRD(124.2,Y,0)),OK=$S($P(Z,"^",4)=NURSPROB:$$OK(Y),1:$$DCOK(Y)) Q:'OK
- Q OK
- OK(Z) ; PART OF DCOK WHICH RETURNS 0 IF PROBLEM Z IS NOT RESOLVED, ELSE 1
- Q:'$D(^GMR(124.3,GMRGPDA,1,"ALIST",Z)) 1
- S Z=+$O(^NURSC(216.8,NURSCPE,"EVAL","AA",Z,0)),Z=+$O(^(Z,0))
- Q Z'>0!+$P($G(^NURSC(216.8,NURSCPE,"EVAL",Z,0)),"^",4)
- ;
- METGOAL(STAT) ; IF PROBLEM IS RESOLVED SET GOAL STATUS TO STAT.
- N NURSGOAL,NURSGOEX
- S NURSGOAL=+$O(^GMRD(124.25,"AA","NURSC","GOAL",0)),NURSGOEX=+$O(^GMRD(124.25,"AA","NURSC","GOALS/EXPECTED OUTCOMES",0)),NURSPROB=+$O(^GMRD(124.25,"AA","NURSC","NURSING PROBLEM",0))
- F X=0:0 S X=$O(^GMRD(124.2,+GMRGTERM,1,"B",X)) Q:X'>0 S Y=$G(^GMRD(124.2,X,0)) I $P(Y,"^",4)=NURSGOEX D PRCGO(X)
- Q
- PRCGO(DA) ; STEP THROUGH CHILDREN OF X IF CHILD GOAL THEN DC IF IN NCP
- N X
- F X=0:0 S X=$O(^GMRD(124.2,DA,1,"B",X)) Q:X'>0 S Y=$G(^GMRD(124.2,X,0)) D PRCG
- Q
- PRCG ; IF Y IS GOAL THEN STATUS=MET IF IN NCP, ELSE RECURSIVELY CALL PRCGO
- I $P(Y,"^",4)=NURSGOAL S NURSI=+$O(^NURSC(216.8,NURSCPE,"TARG","AA",X,0)),NURSJ=+$O(^(NURSI,0)),Y=$G(^NURSC(216.8,NURSCPE,"TARG",NURSJ,0)) D MET:Y]""&($P(Y,"^",2)'=1) Q
- D PRCGO(X)
- Q
- MET ; SET STATUS OF GOAL TO STAT
- Q:'$$DCOK(X) S Y=X N DA,X
- S DA(1)=NURSCPE,NURSZN=$P(^NURSC(216.8,NURSCPE,"TARG",0),"^",3,4),DA=$P(NURSZN,"^",1)+1,NURSNUM=$P(NURSZN,"^",2) F DA=DA:1 Q:'$D(^NURSC(216.8,NURSCPE,"TARG",DA,0))
- S $P(^NURSC(216.8,DA(1),"TARG",0),"^",3,4)=DA_"^"_(NURSNUM+1),^NURSC(216.8,DA(1),"TARG",DA,0)=NURSNWDT_"^"_STAT_"^"_Y_"^"_DUZ_"^"_NURSNWDT
- S DIK="^NURSC(216.8,DA(1),""TARG""," D IX1^DIK
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCCPU5 3042 printed Feb 18, 2025@23:46:44 Page 2
- NURCCPU5 ;HIRMFO/RD/RM-NURSING CARE PLAN UTILITIES (cont.) ;8/29/96
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- DCINT ; DC ALL INTERVENTIONS UNDER A PROBLEM
- +1 SET NURSORD=+$ORDER(^GMRD(124.25,"AA","NURSC","ORDERABLE",0))
- SET NURSINT=+$ORDER(^GMRD(124.25,"AA","NURSC","NURSING INTERVENTION",0))
- SET NURSPROB=+$ORDER(^GMRD(124.25,"AA","NURSC","NURSING PROBLEM",0))
- +2 FOR X=0:0
- SET X=$ORDER(^GMRD(124.2,+GMRGTERM,1,"B",X))
- if X'>0
- QUIT
- SET Y=$GET(^GMRD(124.2,X,0))
- IF $PIECE(Y,"^",4)=NURSINT
- DO PRCINT(X)
- +3 QUIT
- PRCINT(DA) ; STEP THROUGH CHILDREN OF X IF CHILD ORDERABLE THEN DC IF IN NCP
- +1 NEW X
- +2 FOR X=0:0
- SET X=$ORDER(^GMRD(124.2,DA,1,"B",X))
- if X'>0
- QUIT
- SET Y=$GET(^GMRD(124.2,X,0))
- DO PRC
- +3 QUIT
- PRC ; IF Y IS ORDERABLE THEN DC IF IN NCP, ELSE RECURSIVELY CALL PRCINT
- +1 IF $PIECE(Y,"^",4)=NURSORD
- SET NURSI=+$ORDER(^NURSC(216.8,NURSCPE,"ORD","AA",X,0))
- SET NURSJ=+$ORDER(^(NURSI,0))
- SET Y=$GET(^NURSC(216.8,NURSCPE,"ORD",NURSJ,0))
- if Y]""&($PIECE(Y,"^",3)'=1)
- DO DC
- QUIT
- +2 DO PRCINT(X)
- +3 QUIT
- DC ; DC AN ORDER
- +1 if '$$DCOK(X)
- QUIT
- SET Y=X
- NEW DA,X
- +2 SET DA(1)=NURSCPE
- SET NURSZN=$PIECE(^NURSC(216.8,NURSCPE,"ORD",0),"^",3,4)
- SET DA=$PIECE(NURSZN,"^",1)+1
- SET NURSNUM=$PIECE(NURSZN,"^",2)
- FOR DA=DA:1
- if '$DATA(^NURSC(216.8,NURSCPE,"ORD",DA,0))
- QUIT
- +3 SET $PIECE(^NURSC(216.8,DA(1),"ORD",0),"^",3,4)=DA_"^"_(NURSNUM+1)
- SET ^NURSC(216.8,DA(1),"ORD",DA,0)=NURSNWDT_"^"_Y_"^1^"_DUZ
- +4 SET DIK="^NURSC(216.8,DA(1),""ORD"","
- DO IX1^DIK
- +5 QUIT
- DCOK(X) ; ARE ALL PROBLEMS UNDER WHICH AGGY TERM WITH IEN X LIES RESOLVED
- +1 ; THIS FUNCTION RETURNS 1 IF THIS STATEMENT IS TRUE, ELSE 0.
- +2 NEW Y,Z,OK
- +3 SET OK=1
- FOR Y=0:0
- SET Y=$ORDER(^GMRD(124.2,"AKID",X,Y))
- if Y'>0
- QUIT
- SET Z=$GET(^GMRD(124.2,Y,0))
- SET OK=$SELECT($PIECE(Z,"^",4)=NURSPROB:$$OK(Y),1:$$DCOK(Y))
- if 'OK
- QUIT
- +4 QUIT OK
- OK(Z) ; PART OF DCOK WHICH RETURNS 0 IF PROBLEM Z IS NOT RESOLVED, ELSE 1
- +1 if '$DATA(^GMR(124.3,GMRGPDA,1,"ALIST",Z))
- QUIT 1
- +2 SET Z=+$ORDER(^NURSC(216.8,NURSCPE,"EVAL","AA",Z,0))
- SET Z=+$ORDER(^(Z,0))
- +3 QUIT Z'>0!+$PIECE($GET(^NURSC(216.8,NURSCPE,"EVAL",Z,0)),"^",4)
- +4 ;
- METGOAL(STAT) ; IF PROBLEM IS RESOLVED SET GOAL STATUS TO STAT.
- +1 NEW NURSGOAL,NURSGOEX
- +2 SET NURSGOAL=+$ORDER(^GMRD(124.25,"AA","NURSC","GOAL",0))
- SET NURSGOEX=+$ORDER(^GMRD(124.25,"AA","NURSC","GOALS/EXPECTED OUTCOMES",0))
- SET NURSPROB=+$ORDER(^GMRD(124.25,"AA","NURSC","NURSING PROBLEM",0))
- +3 FOR X=0:0
- SET X=$ORDER(^GMRD(124.2,+GMRGTERM,1,"B",X))
- if X'>0
- QUIT
- SET Y=$GET(^GMRD(124.2,X,0))
- IF $PIECE(Y,"^",4)=NURSGOEX
- DO PRCGO(X)
- +4 QUIT
- PRCGO(DA) ; STEP THROUGH CHILDREN OF X IF CHILD GOAL THEN DC IF IN NCP
- +1 NEW X
- +2 FOR X=0:0
- SET X=$ORDER(^GMRD(124.2,DA,1,"B",X))
- if X'>0
- QUIT
- SET Y=$GET(^GMRD(124.2,X,0))
- DO PRCG
- +3 QUIT
- PRCG ; IF Y IS GOAL THEN STATUS=MET IF IN NCP, ELSE RECURSIVELY CALL PRCGO
- +1 IF $PIECE(Y,"^",4)=NURSGOAL
- SET NURSI=+$ORDER(^NURSC(216.8,NURSCPE,"TARG","AA",X,0))
- SET NURSJ=+$ORDER(^(NURSI,0))
- SET Y=$GET(^NURSC(216.8,NURSCPE,"TARG",NURSJ,0))
- if Y]""&($PIECE(Y,"^",2)'=1)
- DO MET
- QUIT
- +2 DO PRCGO(X)
- +3 QUIT
- MET ; SET STATUS OF GOAL TO STAT
- +1 if '$$DCOK(X)
- QUIT
- SET Y=X
- NEW DA,X
- +2 SET DA(1)=NURSCPE
- SET NURSZN=$PIECE(^NURSC(216.8,NURSCPE,"TARG",0),"^",3,4)
- SET DA=$PIECE(NURSZN,"^",1)+1
- SET NURSNUM=$PIECE(NURSZN,"^",2)
- FOR DA=DA:1
- if '$DATA(^NURSC(216.8,NURSCPE,"TARG",DA,0))
- QUIT
- +3 SET $PIECE(^NURSC(216.8,DA(1),"TARG",0),"^",3,4)=DA_"^"_(NURSNUM+1)
- SET ^NURSC(216.8,DA(1),"TARG",DA,0)=NURSNWDT_"^"_STAT_"^"_Y_"^"_DUZ_"^"_NURSNWDT
- +4 SET DIK="^NURSC(216.8,DA(1),""TARG"","
- DO IX1^DIK
- +5 QUIT
