source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURCEVE1.m@ 1328

Last change on this file since 1328 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 4.8 KB
Line 
1NURCEVE1 ;HIRMFO/RTK,RM-Nursing Care Plans Edit Report ;8/29/96
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3GETPROB(NURENT,DATE) ; GIVEN ENTRY IN 216.8 (NURENT), FUNCTION WILL
4 ; RETURN NUMBER OF ACTIVE PROBLEMS FOUND. IF
5 ; COUNT>0, PROBLEMS WILL BE IN ^TMP("NURCHC",$J,X) ARRAY
6 ; WHERE 1 <= X <=COUNT
7 ;
8 ; DATE (optional) CAN BE SET TO SCREEN OUT ONLY THOSE PROBLEMS
9 ; THAT NEED TO BE EVALUATED AS OF THIS DATE
10 ;
11 I $G(DATE)="" S DATE=""
12 K ^TMP("NURPRB",$J),^TMP("NURCHC",$J)
13 N NURACM
14 S NURACM=$$SRTPROB($$GETPRB(NURENT,DATE))
15 K ^TMP("NURPRB",$J)
16 Q NURACM
17 ;
18GETPRB(NURENT,DATE) ; GIVEN ENTRY IN 216.8 (NURENT), FUNCTION WILL
19 ; RETURN 1 IF THERE ARE ACTIVE PROBLEMS, ELSE 0.
20 ; IF FUNCTION RETURNS 1, THEN PROBLEMS WILL BE IN:
21 ; ^TMP("NURPRB",$J,PROBNAME,PROBIEN,GMRGPDA) ARRAY
22 ; WHERE PROBNAME=FREE TEXT, PROBIEN=PTR 124.2, GMRGPDA=PTR 124.3
23 ;
24 ; AN OPTIONAL VARIABLE DATE CAN BE SET TO SCREEN OUT ONLY THOSE PROBLEMS
25 ; THAT NEED TO BE EVALUATED AS OF THIS DATE
26 ;
27 I $G(DATE)="" S DATE=""
28 N IEN,NURDATE,NURMUL,NURPRB,NURSTAT,PROBNAME,REVDT,X,Y
29 S NURCPRB=$O(^GMRD(124.25,"AA","NURSC","NURSING PROBLEM",0))
30 F NURMUL=0:0 S NURMUL=$O(^NURSC(216.8,NURENT,"PROB",NURMUL)) Q:NURMUL'>0 D
31 . S NURPRB=+$G(^NURSC(216.8,NURENT,"PROB",NURMUL,0)) Q:NURPRB'>0
32 . S X=$G(^GMRD(124.2,NURPRB,0)),PROBNAME=$P(X,U) Q:PROBNAME=""
33 . I $P(X,U,4)'=NURCPRB!'$$ACTIVE^NURCEVE2(GMRGPDA,NURPRB) Q
34 . S (NURSTAT,NURDATE)=""
35 . 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
36 . . S X=$G(^NURSC(216.8,NURENT,"EVAL",IEN,0))
37 . . S NURSTAT=$P(X,U,4)
38 . . S Y=$P(X,U,5) D DD^%DT S NURDATE=$P(X,U,5)_U_Y
39 . . Q
40 . 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)
41 . Q
42 K NURCPRB
43 Q $O(^TMP("NURPRB",$J,""))'=""
44 ;
45SRTPROB(NURACM) ; GIVEN FLAG (NURACM) AS $S(0:NO ARRAY,1:ARRAY EXISTS)
46 ; WHERE ARRAY IS ^TMP("NURPRB",$J,PROBNAME,NURPRB,GMRGPDA), THIS
47 ; FUNCTION WILL RETURN NUMBER OF ARRAY ELEMENTS (COUNT) AND IF
48 ; COUNT>0 THIS FUNCTION WILL RETURN ^TMP("NURCHC",$J,X) ARRAY
49 ; WHERE X IS 1 <= X <= COUNT.
50 N GMRGPDA,NURPRB,PROBNAME
51 I NURACM=1 D
52 . S NURACM=0,PROBNAME=""
53 . 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
54 . . S NURACM=NURACM+1
55 . . S ^TMP("NURCHC",$J,NURACM)=NURPRB_U_$G(^TMP("NURPRB",$J,PROBNAME,NURPRB,GMRGPDA))_U_GMRGPDA
56 . . Q
57 . Q
58 Q NURACM
59PCKPROB(NURACM) ; GIVEN NUMBER OF SELECTIONS TO PRINT (NURACM)
60 ; FUNCTION WILL RETURN 1 IF USER HAS SELECTIONS TO PROCESS, 0 IF USER
61 ; SELECTED NO PROBLEMS, AND -1 IF USER ABNORMALLY EXITED, IF
62 ; FUNCTION RETURNS 1, THE LIST OF PROBLEMS USER WISHES TO PROCESS
63 ; WILL BE IN ^TMP("NURUSL",$J)
64 N NURUSL S NURUSL=0 K ^TMP("NURUSL",$J)
65 I NURACM'>0 W !,"THERE ARE NO PROBLEMS FOR THIS PATIENT."
66 E D
67 . S NURCNT=0 D HDR
68 . F NURCNT=1:1:NURACM D Q:NUROUT
69 . . 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
70 . . W !,NURCNT,?3,$E(GMRGXPRT,1,43),?48,$P($G(NURCPDT($P(X,U,4))),U,2),?68,$P(X,U,3)
71 . . D:IOSL-4<$Y!(NURCNT=NURACM) HDR
72 . . Q
73 . S NURUSL=$S(NUROUT:-1,1:''$O(^TMP("NURUSL",$J,"")))
74 . Q
75 K DIR,NURCNT
76 Q NURUSL
77HDR ; HEADER FOR PROBLEM LISTING
78 I NURCNT>0 D Q:NUROUT
79 . 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."
80 . S DIR("?",2)="Enter RD to redisplay this list of selections"_$S(NURCNT'=NURACM:", or <RET> to see more selections",1:"")_".",DIR("?",3)=""
81 . 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
82 . I "^^"[Y S:Y=U!(Y="^^")!$D(DTOUT) NUROUT=1 Q
83 . I $G(NURRD)>0 S NURCNT=0 Q
84 . 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)=""
85 . Q
86 I NURCNT'=NURACM W #,!!,?48,"DATE/TIME",?68,"EVALUATION",!?3,"PROBLEM",?48,"DEVELOPED",?68,"DATE"
87 Q
88VALIDATE(X,GMR) ; GIVEN X AS INPUT TO READ FOR CHOOSING SELECTIONS
89 ; ENTRY WILL KILL X IF INVALID, ELSE WILL RETURN A TRANSFORMED
90 ; VERSION OF X
91 S:$G(GMR)="" GMR=0
92 N NURX,NURY
93 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
94 F NURY=1:1:$L(X,",") S NURX=$P(X,",",NURY) D Q:'$D(X)
95 . I NURX'?1N.N,NURX'?1N.N1"-"1N.N K X
96 . E I NURX?1N.N K:NURX<1!(NURX>NURCNT) X
97 . E K:$P(NURX,"-")<1!($P(NURX,"-",2)>NURCNT)!($P(NURX,"-")>$P(NURX,"-",2)) X
98 . Q
99 Q
Note: See TracBrowser for help on using the repository browser.