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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCCPU0 3997 printed Apr 09, 2024@21:23:40 Page 2
NURCCPU0 ;HIRMFO/RM-NURSING CARE PLAN UTILITIES ;1/28/93
+1 ;;4.0;NURSING SERVICE;**22**;Apr 25, 1997
EN3 ; IF A NURSING PROBLEM HAS BEEN SELECTED IN THE GMR SYSTEM, THEN
+1 ; IT MUST BE ADDED TO THE PROBLEM LIST IN THE NURS CARE PLAN FILE.
+2 SET NURSPROB=$SELECT($DATA(NURSPROB):NURSPROB+1,1:1)
SET NURSPROB(NURSPROB)=GMRGTERM
if '$DATA(NURSCPE)
QUIT
if $DATA(^NURSC(216.8,NURSCPE,"PROB","B",$PIECE(GMRGTERM,"^")))
QUIT
+3 IF '$DATA(^NURSC(216.8,NURSCPE,"PROB",0))
SET ^NURSC(216.8,NURSCPE,"PROB",0)="^216.81P^^"
+4 SET NURSD=$PIECE(^NURSC(216.8,NURSCPE,"PROB",0),"^",3,4)
SET DA=$PIECE(NURSD,"^",1)+1
SET NURSNUM=$PIECE(NURSD,"^",2)
FOR DA=DA:1
if '$DATA(^NURSC(216.8,NURSCPE,"PROB",DA,0))
QUIT
+5 SET X=$PIECE(GMRGTERM,"^")
SET DA(1)=NURSCPE
SET $PIECE(^NURSC(216.8,DA(1),"PROB",0),"^",3,4)=DA_"^"_(NURSNUM+1)
SET ^NURSC(216.8,DA(1),"PROB",DA,0)=X
SET DIK="^NURSC(216.8,DA(1),""PROB"","
DO IX1^DIK
+6 KILL DIK,NURSD,NURSNUM,NURSI
+7 QUIT
EN5 ; IF GOAL HAS BEEN SELECTED, THEN EDIT ITS TARGET DATE.
+1 if '$DATA(^GMR(124.3,GMRGPDA,1,"ALIST",$PIECE(GMRGTERM,"^")))!GMRGOUT
QUIT
+2 SET NURSGOAL=$ORDER(^NURSC(216.8,NURSCPE,"TARG","AA",$PIECE(GMRGTERM,"^"),0))
SET NURSGODA=$SELECT(NURSGOAL>0:$ORDER(^NURSC(216.8,NURSCPE,"TARG","AA",$PIECE(GMRGTERM,"^"),NURSGOAL,0)),1:"")
+3 SET NURSGOND=$SELECT(NURSGODA="":"",$DATA(^NURSC(216.8,NURSCPE,"TARG",NURSGODA,0)):^(0),1:"")
SET Y=$PIECE(NURSGOND,"^",5)
SET NURSGOMT=+$PIECE(NURSGOND,"^",2)
if Y
DO D^DIQ
SET NURSTARG=Y
+4 WRITE !!,$CHAR(7),$SELECT(NURSTARG'="":"For ",1:"")
SET GMRGXPRT="'"_$PIECE(GMRGTERM,"^",2)
SET GMRGXPRT(1)=$SELECT(NURSTARG'="":4,1:0)_"^"_IOM_"^1^0"
+5 SET GMRGXPRT(0)=$SELECT($PIECE(GMRGTERM,"^",3)="":"",$DATA(^GMR(124.3,GMRGPDA,1,$PIECE(GMRGTERM,"^",3),0)):$PIECE(^(0),"^",2),1:"")
IF $PIECE(GMRGXPRT(0),"|")'=""
SET $PIECE(GMRGXPRT(0),"|")=$PIECE(GMRGXPRT(0),"|")_"'"
+6 IF '$TEST
SET GMRGXPRT=GMRGXPRT_"'"
+7 DO EN1^GMRGRUT2
+8 IF NURSTARG'=""
WRITE !,"the most current target date is:",!?5,$PIECE("TARGET^MET^DC","^",NURSGOMT+1)_" DATE: ",NURSTARG,$SELECT('NURSGOMT:"",1:" (GOAL "_$PIECE("MET^DC'D","^",NURSGOMT)_")")
+9 IF '$TEST
WRITE !,"has no target date information."
+10 SET NURFLAG=1
SET NURFLAG(0)=1
IF $PIECE(NURSGOND,"^",5)=""
SET NURFLAG=0
DO TDATE
if GMRGOUT
GOTO Q5
+11 IF NURSGOMT
IF NURFLAG
SET NURFLAG(0)=0
DO RETARG
if NURSGOMT!GMRGOUT
GOTO Q5
+12 IF NURFLAG
DO TDATE
if GMRGOUT
GOTO Q5
+13 IF $PIECE(NURSNWDT,".")'>DT
IF NURFLAG
IF NURFLAG(0)
DO MET
if GMRGOUT
GOTO Q5
+14 if (NURSGOMT_"^"_$PIECE(GMRGTERM,"^")_"^"_DUZ_"^"_NURSNWDT)=$PIECE(NURSGOND,"^",2,5)
GOTO Q5
+15 IF '$DATA(^NURSC(216.8,NURSCPE,"TARG",0))
SET ^(0)="^216.83DI^^"
+16 SET DA(1)=NURSCPE
SET NURSZN=$PIECE(^NURSC(216.8,DA(1),"TARG",0),"^",3,4)
SET DA=$PIECE(NURSZN,"^")+1
SET NURSNUM=$PIECE(NURSZN,"^",2)
FOR DA=DA:1
if '$DATA(^NURSC(216.8,DA(1),"TARG",DA,0))
QUIT
+17 DO NOW^%DTC
SET NURSNWDT(0)=%
SET ^NURSC(216.8,DA(1),"TARG",DA,0)=NURSNWDT(0)_"^"_NURSGOMT_"^"_$PIECE(GMRGTERM,"^")_"^^"_NURSNWDT
SET $PIECE(^NURSC(216.8,DA(1),"TARG",0),"^",3,4)=DA_"^"_(NURSNUM+1)
+18 FOR NURSJ=1:1
SET X=$PIECE($GET(^NURSC(216.8,DA(1),"TARG",DA,0)),"^",NURSJ)
if X'>0
QUIT
SET DIK="^NURSC(216.8,DA(1),""TARG"","
DO IX1^DIK
Q5 KILL %,%DT,DIK,NURDFLT,NURFLAG,NURSGOAL,NURSGOND,NURSGODA,NURSTARG,NURSGOMT,NURSI,NURSJ,NURSNUM,NURSNWDT
+1 QUIT
MET ; GOAL MET ??
+1 WRITE !,"Has this goal been met"
SET %=$SELECT(NURSGOMT:1,1:2)
DO YN^DICN
IF %=-1!(%=1)
if %=-1
SET GMRGOUT=1
if %'=-1
SET NURSGOMT=$SELECT(%=1:1,1:0)
QUIT
+2 IF '%
WRITE !?5,$CHAR(7),"Answer Yes if this goal has been met by the patient, else answer No."
GOTO MET
DCD WRITE !,"Should this goal be discontinued"
SET %=$SELECT(NURSGOMT:1,1:2)
DO YN^DICN
IF %=-1!(%=1)!(%=2)
if %=-1
SET GMRGOUT=1
if %'=-1
SET NURSGOMT=$SELECT(%=1:2,1:0)
QUIT
+1 WRITE !?5,$CHAR(7),"Answer Yes if this goal is no longer appropriate for this patient,",!?5,"else answer No."
+2 GOTO DCD
RETARG ; IS GOAL TO BE REDONE ??
+1 WRITE !,"Is this goal to be reactivated"
SET %=0
DO YN^DICN
IF %=-1!(%=1)!(%=2)
if %=-1
SET GMRGOUT=1
if %'=-1
SET NURSGOMT=$SELECT(%=1:0,1:1)
QUIT
+2 WRITE !?5,$CHAR(7),"Answer Yes if this goal is once again pertinent for this patient,",!?5,"else answer No."
+3 GOTO RETARG
TDATE ; TARGET DATE
+1 ; default target date
SET NURDFLT=$PIECE($GET(^DIC(213.9,1,"CPD")),U,2)
SET NURDFLT=$SELECT(NURDFLT]"":NURDFLT,1:"T+5")
+2 SET %DT("B")=$SELECT($PIECE(NURSGOND,"^",5)<DT!'NURFLAG:NURDFLT,1:$PIECE(NURSGOND,"^",5))
IF +%DT("B")
SET Y=%DT("B")
DO D^DIQ
SET %DT("B")=Y
+3 SET %DT("A")="TARGET DATE: "
SET %DT="AE"
SET %DT(0)=DT
DO ^%DT
KILL %DT
if X?1"^".E
SET GMRGOUT=1
IF Y'>0
SET GMRGOUT=1
QUIT
+4 SET NURSNWDT=+Y
if $PIECE(NURSNWDT,".")>DT
SET NURSGOMT=0
+5 QUIT
