Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: NURCCPU3

NURCCPU3.m

Go to the documentation of this file.
  1. NURCCPU3 ;HIRMFO/RD/RM,RTK/MD-NURSING CARE PLAN UTILITIES (cont.) ;8/16/95
  1. ;;4.0;NURSING SERVICE;;Apr 25, 1997
  1. EN1 ;ENTRY POINT TP PRINT DISCONTINUE DATES OF ANY ORDERS IN THE LIST
  1. ;OF ACTIVE INTERVENTIONS
  1. Q:'$P(GMRGSEL,"^",3)
  1. S NURSORD=$O(^NURSC(216.8,NURSCPE,"ORD","AA",$P(GMRGSEL,"^"),0)) G:NURSORD'>0 Q1 S NURSORD1=$O(^(NURSORD,0)) G:NURSORD1'>0 Q1 S NURORDT=$S($D(^NURSC(216.8,NURSCPE,"ORD",NURSORD1,0)):^(0),1:"")
  1. G Q1:'$P(NURORDT,"^",3) S Y=$P(NURORDT,"^"),NURDATE=$S(Y:$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3),1:"")
  1. S GMRGHPRT(1)="67^"_NURDATE_"/DC"
  1. Q1 ;
  1. K NURSORD,NURSORD1,NURORDT,Y,NURDATE
  1. Q
  1. EN2 ; UPON EXITING A NURSING PROBLEM, UPDATE STATUS ALSO KILL NURSPROB
  1. G:'$D(^GMR(124.3,GMRGPDA,1,"ALIST",+GMRGTERM))!GMRGOUT Q2
  1. S NURSEVAL=$O(^NURSC(216.8,NURSCPE,"EVAL","AA",+GMRGTERM,0)),NURSEVDA=$O(^NURSC(216.8,NURSCPE,"EVAL","AA",+GMRGTERM,+NURSEVAL,0))
  1. S NURSEVND=$G(^NURSC(216.8,NURSCPE,"EVAL",+NURSEVDA,0)),NURSTAT=+$P(NURSEVND,"^",4),NURSREEV=$P(NURSEVND,"^",5)
  1. W !!,$C(7),$S(NURSEVDA>0:"Last evaluation for ",1:"")
  1. S GMRGXPRT="'"_$P(GMRGTERM,"^",2),GMRGXPRT(0)=$S($P(GMRGTERM,"^",3)="":"",$D(^GMR(124.3,GMRGPDA,1,$P(GMRGTERM,"^",3),0)):$P(^(0),"^",2),1:""),GMRGXPRT(1)=$S(NURSEVDA>0:20,1:0)_"^"_IOM_"^1^0"
  1. I $P(GMRGXPRT(0),"|")'="" S $P(GMRGXPRT(0),"|")=$P(GMRGXPRT(0),"|")_"'"
  1. E S GMRGXPRT=GMRGXPRT_"'"
  1. D EN1^GMRGRUT2
  1. I NURSEVDA>0 D
  1. . W !?5,"Evaluation Date: " S Y=NURSREEV D DT^DIQ Q
  1. E W !,"has no previous evaluation."
  1. W !
  1. K DIR S DIR(0)="SOA^A:Active;R:Resolved;S:Suspended;U:Unresolved @ Discharge",DIR("A")="PROBLEM STATUS: ",DIR("B")=$P("Active^Resolved^Suspended^Unresolved @ Discharge",U,NURSTAT+1)
  1. S DIR("?",1)=" The following are valid responses:",DIR("?",2)=" A if problem is still ACTIVE",DIR("?",3)=" R if problem is RESOLVED",DIR("?",4)=" S if problem has been SUSPENDED"
  1. S DIR("?",5)=" U if problem was UNRESOLVED @ DISCHARGE",DIR("?")=" Enter the appropriate status of the problem."
  1. D ^DIR K DIR I "^^"[Y S GMRGOUT=1 G Q2
  1. S NURSTAT=$F("ARSU",Y)-2
  1. I 'NURSTAT D
  1. . I $P(NURSEVND,U,4) W !,"THIS PROBLEM WILL BE REOPENED."
  1. . S NURDFLT=$P($G(^DIC(213.9,1,"CPD")),U),NURDFLT=$S(NURDFLT]"":NURDFLT,1:"T+5") ; default evaluation date
  1. . K DIR S DIR(0)="DA^"_DT_"::E",DIR("A")="DATE PROBLEM TO BE RE-EVALUATED: ",DIR("B")=$S(NURSREEV<DT:NURDFLT,1:$$FMTE^XLFDT(NURSREEV))
  1. . S DIR("?",1)="Enter the date that this problem should be re-evaluated.",DIR("?")="Please use valid FileMan date format."
  1. . D ^DIR K DIR I "^^"[Y S GMRGOUT=1 Q
  1. . S NURSREEV=Y
  1. . Q
  1. E S:NURSTAT'=$P(NURSEVND,"^",4) NURSREEV=DT S:$D(NCPFLG) NCPFLG=0
  1. G Q2:(NURSTAT_"^"_NURSREEV)=$P(NURSEVND,"^",4,5)
  1. I '$D(^NURSC(216.8,NURSCPE,"EVAL",0)) S ^(0)="^216.82DI^^"
  1. S DA(1)=NURSCPE,NURSZN=$P(^NURSC(216.8,NURSCPE,"EVAL",0),"^",3,4),DA=$P(NURSZN,"^",1)+1,NURSNUM=$P(NURSZN,"^",2) F DA=DA:1 Q:'$D(^NURSC(216.8,NURSCPE,"EVAL",DA,0))
  1. S NURSNWDT=$$HTFM^XLFDT($H),$P(^NURSC(216.8,DA(1),"EVAL",0),"^",3,4)=DA_"^"_(NURSNUM+1),^NURSC(216.8,DA(1),"EVAL",DA,0)=NURSNWDT_"^"_$P(GMRGTERM,"^")_"^^"_NURSTAT_"^"_NURSREEV
  1. S DIK="^NURSC(216.8,"_DA(1)_",""EVAL""," D IX1^DIK
  1. I "^1^2^3^"[("^"_NURSTAT_"^"),'$P(NURSEVND,"^",4) D DCINT^NURCCPU5,METGOAL^NURCCPU5($S(NURSTAT=1:1,1:2)) ;**WAIT FOR EP DECISION ON THIS AS FAR AS UPDATING STATUS**
  1. Q2 K %,%DT,DA,NURDFLT,NURSEVAL,NURSEVND,NURSEVDA,NURSI,NURSJ,NURSNUM,NURSNWDT,NURSTAT,NURSREEV,NURSZN,NURFLAG,X,NURSORD,NURSINT
  1. I $D(NURSPROB) K NURSPROB(NURSPROB) S NURSPROB=NURSPROB-1 K:'NURSPROB NURSPROB
  1. Q