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

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

initial load of WorldVistAEHR

File size: 3.9 KB
Line 
1NURCCPU0 ;HIRMFO/RM-NURSING CARE PLAN UTILITIES ;1/28/93
2 ;;4.0;NURSING SERVICE;**22**;Apr 25, 1997
3EN3 ; IF A NURSING PROBLEM HAS BEEN SELECTED IN THE GMR SYSTEM, THEN
4 ; IT MUST BE ADDED TO THE PROBLEM LIST IN THE NURS CARE PLAN FILE.
5 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,"^")))
6 I '$D(^NURSC(216.8,NURSCPE,"PROB",0)) S ^NURSC(216.8,NURSCPE,"PROB",0)="^216.81P^^"
7 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))
8 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
9 K DIK,NURSD,NURSNUM,NURSI
10 Q
11EN5 ; IF GOAL HAS BEEN SELECTED, THEN EDIT ITS TARGET DATE.
12 Q:'$D(^GMR(124.3,GMRGPDA,1,"ALIST",$P(GMRGTERM,"^")))!GMRGOUT
13 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:"")
14 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
15 W !!,$C(7),$S(NURSTARG'="":"For ",1:"") S GMRGXPRT="'"_$P(GMRGTERM,"^",2),GMRGXPRT(1)=$S(NURSTARG'="":4,1:0)_"^"_IOM_"^1^0"
16 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),"|")_"'"
17 E S GMRGXPRT=GMRGXPRT_"'"
18 D EN1^GMRGRUT2
19 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)_")")
20 E W !,"has no target date information."
21 S NURFLAG=1,NURFLAG(0)=1 I $P(NURSGOND,"^",5)="" S NURFLAG=0 D TDATE G Q5:GMRGOUT
22 I NURSGOMT,NURFLAG S NURFLAG(0)=0 D RETARG G Q5:NURSGOMT!GMRGOUT
23 I NURFLAG D TDATE G Q5:GMRGOUT
24 I $P(NURSNWDT,".")'>DT,NURFLAG,NURFLAG(0) D MET G Q5:GMRGOUT
25 G Q5:(NURSGOMT_"^"_$P(GMRGTERM,"^")_"^"_DUZ_"^"_NURSNWDT)=$P(NURSGOND,"^",2,5)
26 I '$D(^NURSC(216.8,NURSCPE,"TARG",0)) S ^(0)="^216.83DI^^"
27 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))
28 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)
29 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
30Q5 K %,%DT,DIK,NURDFLT,NURFLAG,NURSGOAL,NURSGOND,NURSGODA,NURSTARG,NURSGOMT,NURSI,NURSJ,NURSNUM,NURSNWDT
31 Q
32MET ; GOAL MET ??
33 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
34 I '% W !?5,$C(7),"Answer Yes if this goal has been met by the patient, else answer No." G MET
35DCD 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
36 W !?5,$C(7),"Answer Yes if this goal is no longer appropriate for this patient,",!?5,"else answer No."
37 G DCD
38RETARG ; IS GOAL TO BE REDONE ??
39 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
40 W !?5,$C(7),"Answer Yes if this goal is once again pertinent for this patient,",!?5,"else answer No."
41 G RETARG
42TDATE ; TARGET DATE
43 S NURDFLT=$P($G(^DIC(213.9,1,"CPD")),U,2),NURDFLT=$S(NURDFLT]"":NURDFLT,1:"T+5") ; default target date
44 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
45 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
46 S NURSNWDT=+Y S:$P(NURSNWDT,".")>DT NURSGOMT=0
47 Q
Note: See TracBrowser for help on using the repository browser.