- 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 Mar 13, 2025@21:25:17 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
