57 lines
3.5 KiB
Mathematica
57 lines
3.5 KiB
Mathematica
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
|