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