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

NURCEVE1.m

Go to the documentation of this file. 
  1. NURCEVE1 ;HIRMFO/RTK,RM-Nursing Care Plans Edit Report ;8/29/96
  1.  ;;4.0;NURSING SERVICE;;Apr 25, 1997
  1. GETPROB(NURENT,DATE) ; GIVEN ENTRY IN 216.8 (NURENT), FUNCTION WILL
  1.  ; RETURN NUMBER OF ACTIVE PROBLEMS FOUND.  IF
  1.  ; COUNT>0, PROBLEMS WILL BE IN ^TMP("NURCHC",$J,X) ARRAY
  1.  ; WHERE 1 <= X <=COUNT
  1.  ;
  1.  ; DATE (optional) CAN BE SET TO SCREEN OUT ONLY THOSE PROBLEMS
  1.  ; THAT NEED TO BE EVALUATED AS OF THIS DATE
  1.  ;
  1.  I $G(DATE)="" S DATE=""
  1.  K ^TMP("NURPRB",$J),^TMP("NURCHC",$J)
  1.  N NURACM
  1.  S NURACM=$$SRTPROB($$GETPRB(NURENT,DATE))
  1.  K ^TMP("NURPRB",$J)
  1.  Q NURACM
  1.  ;
  1. GETPRB(NURENT,DATE) ; GIVEN ENTRY IN 216.8 (NURENT), FUNCTION WILL
  1.  ; RETURN 1 IF THERE ARE ACTIVE PROBLEMS, ELSE 0.
  1.  ; IF FUNCTION RETURNS 1, THEN PROBLEMS WILL BE IN:
  1.  ;      ^TMP("NURPRB",$J,PROBNAME,PROBIEN,GMRGPDA) ARRAY
  1.  ; WHERE PROBNAME=FREE TEXT, PROBIEN=PTR 124.2, GMRGPDA=PTR 124.3
  1.  ;
  1.  ; AN OPTIONAL VARIABLE DATE CAN BE SET TO SCREEN OUT ONLY THOSE PROBLEMS
  1.  ; THAT NEED TO BE EVALUATED AS OF THIS DATE
  1.  ;
  1.  I $G(DATE)="" S DATE=""
  1.  N IEN,NURDATE,NURMUL,NURPRB,NURSTAT,PROBNAME,REVDT,X,Y
  1.  S NURCPRB=$O(^GMRD(124.25,"AA","NURSC","NURSING PROBLEM",0))
  1.  F NURMUL=0:0 S NURMUL=$O(^NURSC(216.8,NURENT,"PROB",NURMUL)) Q:NURMUL'>0  D
  1.  .   S NURPRB=+$G(^NURSC(216.8,NURENT,"PROB",NURMUL,0)) Q:NURPRB'>0
  1.  .   S X=$G(^GMRD(124.2,NURPRB,0)),PROBNAME=$P(X,U) Q:PROBNAME=""
  1.  .   I $P(X,U,4)'=NURCPRB!'$$ACTIVE^NURCEVE2(GMRGPDA,NURPRB) Q
  1.  .   S (NURSTAT,NURDATE)=""
  1.  .   F REVDT=0:0 S REVDT=$O(^NURSC(216.8,NURENT,"EVAL","AA",NURPRB,REVDT)) Q:REVDT'>0  S IEN=$O(^NURSC(216.8,NURENT,"EVAL","AA",NURPRB,REVDT,0)) I IEN>0 D  Q
  1.  .   .   S X=$G(^NURSC(216.8,NURENT,"EVAL",IEN,0))
  1.  .   .   S NURSTAT=$P(X,U,4)
  1.  .   .   S Y=$P(X,U,5) D DD^%DT S NURDATE=$P(X,U,5)_U_Y
  1.  .   .   Q
  1.  .   I "^1^2^3^"'[NURSTAT&(DATE=""!(DATE'<$P(NURDATE,U))) S ^TMP("NURPRB",$J,$P(NURCPDT(GMRGPDA),U),NURPRB,GMRGPDA)=PROBNAME_U_$P(NURDATE,U,2)
  1.  .   Q
  1.  K NURCPRB
  1.  Q $O(^TMP("NURPRB",$J,""))'=""
  1.  ;
  1. SRTPROB(NURACM) ; GIVEN FLAG (NURACM) AS $S(0:NO ARRAY,1:ARRAY EXISTS)
  1.  ; WHERE ARRAY IS ^TMP("NURPRB",$J,PROBNAME,NURPRB,GMRGPDA), THIS
  1.  ; FUNCTION WILL RETURN NUMBER OF ARRAY ELEMENTS (COUNT) AND IF
  1.  ; COUNT>0 THIS FUNCTION WILL RETURN ^TMP("NURCHC",$J,X) ARRAY
  1.  ; WHERE X IS 1 <= X <= COUNT.
  1.  N GMRGPDA,NURPRB,PROBNAME
  1.  I NURACM=1 D
  1.  .   S NURACM=0,PROBNAME=""
  1.  .   F  S PROBNAME=$O(^TMP("NURPRB",$J,PROBNAME)) Q:PROBNAME=""  F NURPRB=0:0 S NURPRB=$O(^TMP("NURPRB",$J,PROBNAME,NURPRB)) Q:NURPRB'>0  F GMRGPDA=0:0 S GMRGPDA=$O(^TMP("NURPRB",$J,PROBNAME,NURPRB,GMRGPDA)) Q:GMRGPDA'>0  D
  1.  .   .   S NURACM=NURACM+1
  1.  .   .   S ^TMP("NURCHC",$J,NURACM)=NURPRB_U_$G(^TMP("NURPRB",$J,PROBNAME,NURPRB,GMRGPDA))_U_GMRGPDA
  1.  .   .   Q
  1.  .   Q
  1.  Q NURACM
  1. PCKPROB(NURACM) ; GIVEN NUMBER OF SELECTIONS TO PRINT (NURACM)
  1.  ; FUNCTION WILL RETURN 1 IF USER HAS SELECTIONS TO PROCESS, 0 IF USER
  1.  ; SELECTED NO PROBLEMS, AND -1 IF USER ABNORMALLY EXITED, IF
  1.  ; FUNCTION RETURNS 1, THE LIST OF PROBLEMS USER WISHES TO PROCESS
  1.  ; WILL BE IN ^TMP("NURUSL",$J)
  1.  N NURUSL S NURUSL=0 K ^TMP("NURUSL",$J)
  1.  I NURACM'>0 W !,"THERE ARE NO PROBLEMS FOR THIS PATIENT."
  1.  E  D
  1.  .   S NURCNT=0 D HDR
  1.  .   F NURCNT=1:1:NURACM D  Q:NUROUT
  1.  .   .   S X=$G(^TMP("NURCHC",$J,NURCNT)),GMRGXPRT=$P(X,U,2),GMRGPDA=$P(X,U,4),GMRGXPRT(0)=$$SELDAT^NURCEVE2(+X,GMRGPDA),GMRGXPRT(1)="^^1^^1" D EN1^GMRGRUT2
  1.  .   .   W !,NURCNT,?3,$E(GMRGXPRT,1,43),?48,$P($G(NURCPDT($P(X,U,4))),U,2),?68,$P(X,U,3)
  1.  .   .   D:IOSL-4<$Y!(NURCNT=NURACM) HDR
  1.  .   .   Q
  1.  .   S NURUSL=$S(NUROUT:-1,1:''$O(^TMP("NURUSL",$J,"")))
  1.  .   Q
  1.  K DIR,NURCNT
  1.  Q NURUSL
  1. HDR ; HEADER FOR PROBLEM LISTING
  1.  I NURCNT>0 D  Q:NUROUT
  1.  .   W ! K DIR,NURRD S DIR("A")="ENTER THE PROBLEM(S) (BY NUMBER) TO BE EDITED (1"_$S(NURCNT>1:"-"_NURCNT,1:"")_"): ",DIR("?",1)="This response must be a list or range, e.g., 1,3,5 OR 2-4,8."
  1.  .   S DIR("?",2)="Enter RD to redisplay this list of selections"_$S(NURCNT'=NURACM:", or <RET> to see more selections",1:"")_".",DIR("?",3)=""
  1.  .   S DIR("?")="Response should be no less than 1 and no greater than "_NURCNT_".",DIR(0)="FOA^1:60^D VALIDATE^NURCEVE1(.X)" D ^DIR
  1.  .   I "^^"[Y S:Y=U!(Y="^^")!$D(DTOUT) NUROUT=1 Q
  1.  .   I $G(NURRD)>0 S NURCNT=0 Q
  1.  .   F NURY=1:1:$L(Y,",") S NURX=$P(Y,",",NURY),NURZ=$S(NURX'["-":+NURX,1:$P(NURX,"-",2)) F NURX=+NURX:1:NURZ S ^TMP("NURUSL",$J,NURX)=""
  1.  .   Q
  1.  I NURCNT'=NURACM W #,!!,?48,"DATE/TIME",?68,"EVALUATION",!?3,"PROBLEM",?48,"DEVELOPED",?68,"DATE"
  1.  Q
  1. VALIDATE(X,GMR) ; GIVEN X AS INPUT TO READ FOR CHOOSING SELECTIONS
  1.  ; ENTRY WILL KILL X IF INVALID, ELSE WILL RETURN A TRANSFORMED
  1.  ; VERSION OF X
  1.  S:$G(GMR)="" GMR=0
  1.  N NURX,NURY
  1.  I X?1.2A S X=$$UP^XLFSTR(X) S:X="R"!(X="RD") X="RD" K:X'="RD"&('GMR!(X'="A"&GMR)) X S:$D(X)#2 NURRD=1+(X="A") Q
  1.  F NURY=1:1:$L(X,",") S NURX=$P(X,",",NURY) D  Q:'$D(X)
  1.  .   I NURX'?1N.N,NURX'?1N.N1"-"1N.N K X
  1.  .   E  I NURX?1N.N K:NURX<1!(NURX>NURCNT) X
  1.  .   E  K:$P(NURX,"-")<1!($P(NURX,"-",2)>NURCNT)!($P(NURX,"-")>$P(NURX,"-",2)) X
  1.  .   Q
  1.  Q