100 lines
4.8 KiB
Mathematica
100 lines
4.8 KiB
Mathematica
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
|