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

NURCEVP0 ;HIRMFO/RTK,RM,MD-Nursing Care Plans Print Report ;8/29/96
 ;;4.0;NURSING SERVICE;;Apr 25, 1997
ENT1 ;
 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
 S GMRGRT=GMRGRT_"^Nursing Care Plan"
 S NACT=0 D WARDPAT^NURCUT0 G:NURQUIT END
DEV ;  SELECT DEVICE TO SEND OUTPUT TO.
 ;  IF REPORT IS QUEUED, SET UP TASK USING %ZTLOAD AND GET OUT OF ROUTINE
 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
 ;
PRINT ; ENTRY FROM TASKMAN TO PRINT THIS REPORT
 S (PAGE,NURSW1,NUROUT)=0 K ^TMP($J) F X="NURCHC","NURPROB" K ^TMP(X,$J)
 D ^NURCAS2 ; BUILDS ^TMP($J,"NURCEN",ROOM,BED,PATNAME) ARRAY
 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
 .   S DFN=+$G(^TMP($J,"NURCEN",ROOM,BED,PATNAME))
 .   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))
 .   .   S NURSCPE=$O(^NURSC(216.8,"B",GMRGPDA,0)) Q:NURSCPE'>0
 .   .   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)
 .   .   S NUREVDT=$$GETPROB^NURCEVE1(NURSCPE,DT) Q:NUREVDT'>0
 .   .   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)
 .   .   Q
 .   Q
 U IO
 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
 .   S X=$G(^TMP($J,"NURCEN",ROOM,BED,PATNAME)),DFN=+X
 .   I IOSL-4<$Y!'(NURSW1) D HEADER Q:NUROUT
 .   W !!,$$PRTRMBD(ROOM,BED),?17,PATNAME," ",$S($P(X,U,2)'="":"("_$P(X,U,2)_")",1:"")
 .   I $O(^TMP("NURPROB",$J,DFN,""))="" W !?3,"THIS PATIENT HAS NO PROBLEMS TO BE EVALUATED." Q
 .   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
 .   .   F GMRGPDA=0:0 S GMRGPDA=$O(^TMP("NURPROB",$J,DFN,REVDTDV,NURPRB,GMRGPDA)) Q:GMRGPDA'>0  D  Q:NUROUT
 .   .   .   I IOSL-4<$Y D HEADER Q:NUROUT
 .   .   .   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
 .   .   .   W !?3,$E(GMRGXPRT,1,43),?48,$P($G(NURCPDT($P(X1,U,4))),U,2),?68,$P(X1,U,3)
 .   .   .   Q
 .   .   Q
 .   Q
 W !!
END ; CLEAN UP VARIABLES
 K ^TMP($J) F X="NURCHC","NURPROB" K ^TMP(X,$J)
 D CLOSE^NURSUT1,^NURCKILL
 Q
HEADER ; PRINT HEADER FOR REPORT
 I NURSW1,$E(IOST)="C" D ENDPG^NURSUT1 S NUROUT=$G(NUROUT) Q:NUROUT
 W:$E(IOST)="C"!(PAGE>1) @IOF
 S PAGE=PAGE+1,NURSW1=1
 W ! S Y=DT D DT^DIQ W ?23,"Nursing Problems to be Evaluated",?70,"Page ",PAGE
 W !!,"ROOM/BED",?17,"PATIENT (PID)",!,?48,"DATE/TIME",?68,"EVALUATION",!?3,"PROBLEM TO BE EVALUATED",?48,"DEVELOPED",?68,"DATE"
 W !,"=============================================================================="
 Q
PRTRMBD(ROOM,BED) ; THIS FUNTION RETURNS THE PRINTABLE FORM OF ROOM/BED
 N RMBD
 I ROOM'="  BLANK",BED'="  BLANK" S RMBD=ROOM_"-"_BED
 E  I ROOM="  BLANK",BED="  BLANK" S RMBD=""
 E  I ROOM="  BLANK" S RMBD="-"_BED
 E  S RMBD=ROOM_"-"
 Q RMBD