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