source: FOIAVistA/trunk/r/NURSING_SERVICE-NUR/NURCEVP0.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.5 KB
Line 
1NURCEVP0 ;HIRMFO/RTK,RM,MD-Nursing Care Plans Print Report ;8/29/96
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3ENT1 ;
4 S GMRGRT=$O(^GMRD(124.2,"AA","NURSC",2,"Nursing Care Plan","")) I GMRGRT'>0 W !,$C(7),"THERE IS A PROBLEM IN THE ""AA"" XREF.",! G END
5 S GMRGRT=GMRGRT_"^Nursing Care Plan"
6 S NACT=0 D WARDPAT^NURCUT0 G:NURQUIT END
7DEV ; SELECT DEVICE TO SEND OUTPUT TO.
8 ; IF REPORT IS QUEUED, SET UP TASK USING %ZTLOAD AND GET OUT OF ROUTINE
9 S ZTRTN="PRINT^NURCEVP0",ZTDESC="Nursing Care Plan Print Report" D EN7^NURSUT0 K ZTDESC,NURQUEUE I POP!$D(ZTSK) K POP,ZTSK G END
10 ;
11PRINT ; ENTRY FROM TASKMAN TO PRINT THIS REPORT
12 S (PAGE,NURSW1,NUROUT)=0 K ^TMP($J) F X="NURCHC","NURPROB" K ^TMP(X,$J)
13 D ^NURCAS2 ; BUILDS ^TMP($J,"NURCEN",ROOM,BED,PATNAME) ARRAY
14 S ROOM="" F S ROOM=$O(^TMP($J,"NURCEN",ROOM)) Q:ROOM="" S BED="" F S BED=$O(^TMP($J,"NURCEN",ROOM,BED)) Q:BED="" S PATNAME="" F S PATNAME=$O(^TMP($J,"NURCEN",ROOM,BED,PATNAME)) Q:PATNAME="" D
15 . S DFN=+$G(^TMP($J,"NURCEN",ROOM,BED,PATNAME))
16 . F REVDT=0:0 S REVDT=$O(^GMR(124.3,"AA",DFN,+GMRGRT,REVDT)) Q:REVDT'>0 F GMRGPDA=0:0 S GMRGPDA=$O(^GMR(124.3,"AA",DFN,+GMRGRT,REVDT,GMRGPDA)) Q:GMRGPDA'>0 D:'+$G(^GMR(124.3,GMRGPDA,5))
17 . . S NURSCPE=$O(^NURSC(216.8,"B",GMRGPDA,0)) Q:NURSCPE'>0
18 . . S Y=$P($G(^GMR(124.3,GMRGPDA,0)),U,3),DEVDT=9999999.9999-Y D D^DIQ S NURCPDT(GMRGPDA)=DEVDT_"^"_$E(Y,1,18)
19 . . S NUREVDT=$$GETPROB^NURCEVE1(NURSCPE,DT) Q:NUREVDT'>0
20 . . F NURCHC=0:0 S NURCHC=$O(^TMP("NURCHC",$J,NURCHC)) Q:NURCHC'>0 S X=$G(^TMP("NURCHC",$J,NURCHC)) I X'="",$P(X,U,2)'="",+X>0 S ^TMP("NURPROB",$J,DFN,$P(NURCPDT(GMRGPDA),U),+X,GMRGPDA)=X_"^"_$P(NURCPDT(GMRGPDA),U)
21 . . Q
22 . Q
23 U IO
24 S NURX=0,ROOM="" F S ROOM=$O(^TMP($J,"NURCEN",ROOM)) Q:ROOM=""!NUROUT S BED="" F S BED=$O(^TMP($J,"NURCEN",ROOM,BED)) Q:BED=""!NUROUT S PATNAME="" F S PATNAME=$O(^TMP($J,"NURCEN",ROOM,BED,PATNAME)) Q:PATNAME="" D Q:NUROUT
25 . S X=$G(^TMP($J,"NURCEN",ROOM,BED,PATNAME)),DFN=+X
26 . I IOSL-4<$Y!'(NURSW1) D HEADER Q:NUROUT
27 . W !!,$$PRTRMBD(ROOM,BED),?17,PATNAME," ",$S($P(X,U,2)'="":"("_$P(X,U,2)_")",1:"")
28 . I $O(^TMP("NURPROB",$J,DFN,""))="" W !?3,"THIS PATIENT HAS NO PROBLEMS TO BE EVALUATED." Q
29 . S REVDTDV="" F S REVDTDV=$O(^TMP("NURPROB",$J,DFN,REVDTDV)) Q:REVDTDV=""!NUROUT F NURPRB=0:0 S NURPRB=$O(^TMP("NURPROB",$J,DFN,REVDTDV,NURPRB)) Q:NURPRB'>0 D Q:NUROUT
30 . . F GMRGPDA=0:0 S GMRGPDA=$O(^TMP("NURPROB",$J,DFN,REVDTDV,NURPRB,GMRGPDA)) Q:GMRGPDA'>0 D Q:NUROUT
31 . . . I IOSL-4<$Y D HEADER Q:NUROUT
32 . . . S NURX=NURX+1,X1=$G(^TMP("NURPROB",$J,DFN,REVDTDV,NURPRB,GMRGPDA)),GMRGXPRT=$P(X1,U,2),GMRGXPRT(0)=$$SELDAT^NURCEVE2(+X1,GMRGPDA),GMRGXPRT(1)="^^1^^1" D EN1^GMRGRUT2
33 . . . W !?3,$E(GMRGXPRT,1,43),?48,$P($G(NURCPDT($P(X1,U,4))),U,2),?68,$P(X1,U,3)
34 . . . Q
35 . . Q
36 . Q
37 W !!
38END ; CLEAN UP VARIABLES
39 K ^TMP($J) F X="NURCHC","NURPROB" K ^TMP(X,$J)
40 D CLOSE^NURSUT1,^NURCKILL
41 Q
42HEADER ; PRINT HEADER FOR REPORT
43 I NURSW1,$E(IOST)="C" D ENDPG^NURSUT1 S NUROUT=$G(NUROUT) Q:NUROUT
44 W:$E(IOST)="C"!(PAGE>1) @IOF
45 S PAGE=PAGE+1,NURSW1=1
46 W ! S Y=DT D DT^DIQ W ?23,"Nursing Problems to be Evaluated",?70,"Page ",PAGE
47 W !!,"ROOM/BED",?17,"PATIENT (PID)",!,?48,"DATE/TIME",?68,"EVALUATION",!?3,"PROBLEM TO BE EVALUATED",?48,"DEVELOPED",?68,"DATE"
48 W !,"=============================================================================="
49 Q
50PRTRMBD(ROOM,BED) ; THIS FUNTION RETURNS THE PRINTABLE FORM OF ROOM/BED
51 N RMBD
52 I ROOM'=" BLANK",BED'=" BLANK" S RMBD=ROOM_"-"_BED
53 E I ROOM=" BLANK",BED=" BLANK" S RMBD=""
54 E I ROOM=" BLANK" S RMBD="-"_BED
55 E S RMBD=ROOM_"-"
56 Q RMBD
Note: See TracBrowser for help on using the repository browser.