source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURCCPU0.m@ 862

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