48 lines
3.9 KiB
Mathematica
48 lines
3.9 KiB
Mathematica
NURCCPU0 ;HIRMFO/RM-NURSING CARE PLAN UTILITIES ;1/28/93
|
|
;;4.0;NURSING SERVICE;**22**;Apr 25, 1997
|
|
EN3 ; IF A NURSING PROBLEM HAS BEEN SELECTED IN THE GMR SYSTEM, THEN
|
|
; IT MUST BE ADDED TO THE PROBLEM LIST IN THE NURS CARE PLAN FILE.
|
|
S NURSPROB=$S($D(NURSPROB):NURSPROB+1,1:1),NURSPROB(NURSPROB)=GMRGTERM Q:'$D(NURSCPE) Q:$D(^NURSC(216.8,NURSCPE,"PROB","B",$P(GMRGTERM,"^")))
|
|
I '$D(^NURSC(216.8,NURSCPE,"PROB",0)) S ^NURSC(216.8,NURSCPE,"PROB",0)="^216.81P^^"
|
|
S NURSD=$P(^NURSC(216.8,NURSCPE,"PROB",0),"^",3,4),DA=$P(NURSD,"^",1)+1,NURSNUM=$P(NURSD,"^",2) F DA=DA:1 Q:'$D(^NURSC(216.8,NURSCPE,"PROB",DA,0))
|
|
S X=$P(GMRGTERM,"^"),DA(1)=NURSCPE,$P(^NURSC(216.8,DA(1),"PROB",0),"^",3,4)=DA_"^"_(NURSNUM+1),^NURSC(216.8,DA(1),"PROB",DA,0)=X,DIK="^NURSC(216.8,DA(1),""PROB""," D IX1^DIK
|
|
K DIK,NURSD,NURSNUM,NURSI
|
|
Q
|
|
EN5 ; IF GOAL HAS BEEN SELECTED, THEN EDIT ITS TARGET DATE.
|
|
Q:'$D(^GMR(124.3,GMRGPDA,1,"ALIST",$P(GMRGTERM,"^")))!GMRGOUT
|
|
S NURSGOAL=$O(^NURSC(216.8,NURSCPE,"TARG","AA",$P(GMRGTERM,"^"),0)),NURSGODA=$S(NURSGOAL>0:$O(^NURSC(216.8,NURSCPE,"TARG","AA",$P(GMRGTERM,"^"),NURSGOAL,0)),1:"")
|
|
S NURSGOND=$S(NURSGODA="":"",$D(^NURSC(216.8,NURSCPE,"TARG",NURSGODA,0)):^(0),1:""),Y=$P(NURSGOND,"^",5),NURSGOMT=+$P(NURSGOND,"^",2) D:Y D^DIQ S NURSTARG=Y
|
|
W !!,$C(7),$S(NURSTARG'="":"For ",1:"") S GMRGXPRT="'"_$P(GMRGTERM,"^",2),GMRGXPRT(1)=$S(NURSTARG'="":4,1:0)_"^"_IOM_"^1^0"
|
|
S GMRGXPRT(0)=$S($P(GMRGTERM,"^",3)="":"",$D(^GMR(124.3,GMRGPDA,1,$P(GMRGTERM,"^",3),0)):$P(^(0),"^",2),1:"") I $P(GMRGXPRT(0),"|")'="" S $P(GMRGXPRT(0),"|")=$P(GMRGXPRT(0),"|")_"'"
|
|
E S GMRGXPRT=GMRGXPRT_"'"
|
|
D EN1^GMRGRUT2
|
|
I NURSTARG'="" W !,"the most current target date is:",!?5,$P("TARGET^MET^DC","^",NURSGOMT+1)_" DATE: ",NURSTARG,$S('NURSGOMT:"",1:" (GOAL "_$P("MET^DC'D","^",NURSGOMT)_")")
|
|
E W !,"has no target date information."
|
|
S NURFLAG=1,NURFLAG(0)=1 I $P(NURSGOND,"^",5)="" S NURFLAG=0 D TDATE G Q5:GMRGOUT
|
|
I NURSGOMT,NURFLAG S NURFLAG(0)=0 D RETARG G Q5:NURSGOMT!GMRGOUT
|
|
I NURFLAG D TDATE G Q5:GMRGOUT
|
|
I $P(NURSNWDT,".")'>DT,NURFLAG,NURFLAG(0) D MET G Q5:GMRGOUT
|
|
G Q5:(NURSGOMT_"^"_$P(GMRGTERM,"^")_"^"_DUZ_"^"_NURSNWDT)=$P(NURSGOND,"^",2,5)
|
|
I '$D(^NURSC(216.8,NURSCPE,"TARG",0)) S ^(0)="^216.83DI^^"
|
|
S DA(1)=NURSCPE,NURSZN=$P(^NURSC(216.8,DA(1),"TARG",0),"^",3,4),DA=$P(NURSZN,"^")+1,NURSNUM=$P(NURSZN,"^",2) F DA=DA:1 Q:'$D(^NURSC(216.8,DA(1),"TARG",DA,0))
|
|
D NOW^%DTC S NURSNWDT(0)=%,^NURSC(216.8,DA(1),"TARG",DA,0)=NURSNWDT(0)_"^"_NURSGOMT_"^"_$P(GMRGTERM,"^")_"^^"_NURSNWDT,$P(^NURSC(216.8,DA(1),"TARG",0),"^",3,4)=DA_"^"_(NURSNUM+1)
|
|
F NURSJ=1:1 S X=$P($G(^NURSC(216.8,DA(1),"TARG",DA,0)),"^",NURSJ) Q:X'>0 S DIK="^NURSC(216.8,DA(1),""TARG""," D IX1^DIK
|
|
Q5 K %,%DT,DIK,NURDFLT,NURFLAG,NURSGOAL,NURSGOND,NURSGODA,NURSTARG,NURSGOMT,NURSI,NURSJ,NURSNUM,NURSNWDT
|
|
Q
|
|
MET ; GOAL MET ??
|
|
W !,"Has this goal been met" S %=$S(NURSGOMT:1,1:2) D YN^DICN I %=-1!(%=1) S:%=-1 GMRGOUT=1 S:%'=-1 NURSGOMT=$S(%=1:1,1:0) Q
|
|
I '% W !?5,$C(7),"Answer Yes if this goal has been met by the patient, else answer No." G MET
|
|
DCD W !,"Should this goal be discontinued" S %=$S(NURSGOMT:1,1:2) D YN^DICN I %=-1!(%=1)!(%=2) S:%=-1 GMRGOUT=1 S:%'=-1 NURSGOMT=$S(%=1:2,1:0) Q
|
|
W !?5,$C(7),"Answer Yes if this goal is no longer appropriate for this patient,",!?5,"else answer No."
|
|
G DCD
|
|
RETARG ; IS GOAL TO BE REDONE ??
|
|
W !,"Is this goal to be reactivated" S %=0 D YN^DICN I %=-1!(%=1)!(%=2) S:%=-1 GMRGOUT=1 S:%'=-1 NURSGOMT=$S(%=1:0,1:1) Q
|
|
W !?5,$C(7),"Answer Yes if this goal is once again pertinent for this patient,",!?5,"else answer No."
|
|
G RETARG
|
|
TDATE ; TARGET DATE
|
|
S NURDFLT=$P($G(^DIC(213.9,1,"CPD")),U,2),NURDFLT=$S(NURDFLT]"":NURDFLT,1:"T+5") ; default target date
|
|
S %DT("B")=$S($P(NURSGOND,"^",5)<DT!'NURFLAG:NURDFLT,1:$P(NURSGOND,"^",5)) I +%DT("B") S Y=%DT("B") D D^DIQ S %DT("B")=Y
|
|
S %DT("A")="TARGET DATE: ",%DT="AE",%DT(0)=DT D ^%DT K %DT S:X?1"^".E GMRGOUT=1 I Y'>0 S GMRGOUT=1 Q
|
|
S NURSNWDT=+Y S:$P(NURSNWDT,".")>DT NURSGOMT=0
|
|
Q
|