- 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
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCEVP0 3688 printed Mar 13, 2025@21:25:35 Page 2
- NURCEVP0 ;HIRMFO/RTK,RM,MD-Nursing Care Plans Print Report ;8/29/96
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- ENT1 ;
- +1 SET GMRGRT=$ORDER(^GMRD(124.2,"AA","NURSC",2,"Nursing Care Plan",""))
- IF GMRGRT'>0
- WRITE !,$CHAR(7),"THERE IS A PROBLEM IN THE ""AA"" XREF.",!
- GOTO END
- +2 SET GMRGRT=GMRGRT_"^Nursing Care Plan"
- +3 SET NACT=0
- DO WARDPAT^NURCUT0
- if NURQUIT
- GOTO END
- DEV ; SELECT DEVICE TO SEND OUTPUT TO.
- +1 ; IF REPORT IS QUEUED, SET UP TASK USING %ZTLOAD AND GET OUT OF ROUTINE
- +2 SET ZTRTN="PRINT^NURCEVP0"
- SET ZTDESC="Nursing Care Plan Print Report"
- DO EN7^NURSUT0
- KILL ZTDESC,NURQUEUE
- IF POP!$DATA(ZTSK)
- KILL POP,ZTSK
- GOTO END
- +3 ;
- PRINT ; ENTRY FROM TASKMAN TO PRINT THIS REPORT
- +1 SET (PAGE,NURSW1,NUROUT)=0
- KILL ^TMP($JOB)
- FOR X="NURCHC","NURPROB"
- KILL ^TMP(X,$JOB)
- +2 ; BUILDS ^TMP($J,"NURCEN",ROOM,BED,PATNAME) ARRAY
- DO ^NURCAS2
- +3 SET ROOM=""
- FOR
- SET ROOM=$ORDER(^TMP($JOB,"NURCEN",ROOM))
- if ROOM=""
- QUIT
- SET BED=""
- FOR
- SET BED=$ORDER(^TMP($JOB,"NURCEN",ROOM,BED))
- if BED=""
- QUIT
- SET PATNAME=""
- FOR
- SET PATNAME=$ORDER(^TMP($JOB,"NURCEN",ROOM,BED,PATNAME))
- if PATNAME=""
- QUIT
- Begin DoDot:1
- +4 SET DFN=+$GET(^TMP($JOB,"NURCEN",ROOM,BED,PATNAME))
- +5 FOR REVDT=0:0
- SET REVDT=$ORDER(^GMR(124.3,"AA",DFN,+GMRGRT,REVDT))
- if REVDT'>0
- QUIT
- FOR GMRGPDA=0:0
- SET GMRGPDA=$ORDER(^GMR(124.3,"AA",DFN,+GMRGRT,REVDT,GMRGPDA))
- if GMRGPDA'>0
- QUIT
- if '+$GET(^GMR(124.3,GMRGPDA,5))
- Begin DoDot:2
- +6 SET NURSCPE=$ORDER(^NURSC(216.8,"B",GMRGPDA,0))
- if NURSCPE'>0
- QUIT
- +7 SET Y=$PIECE($GET(^GMR(124.3,GMRGPDA,0)),U,3)
- SET DEVDT=9999999.9999-Y
- DO D^DIQ
- SET NURCPDT(GMRGPDA)=DEVDT_"^"_$EXTRACT(Y,1,18)
- +8 SET NUREVDT=$$GETPROB^NURCEVE1(NURSCPE,DT)
- if NUREVDT'>0
- QUIT
- +9 FOR NURCHC=0:0
- SET NURCHC=$ORDER(^TMP("NURCHC",$JOB,NURCHC))
- if NURCHC'>0
- QUIT
- SET X=$GET(^TMP("NURCHC",$JOB,NURCHC))
- IF X'=""
- IF $PIECE(X,U,2)'=""
- IF +X>0
- SET ^TMP("NURPROB",$JOB,DFN,$PIECE(NURCPDT(GMRGPDA),U),+X,GMRGPDA)=X_"^"_$PIECE(NURCPDT(GMRGPDA),U)
- +10 QUIT
- End DoDot:2
- +11 QUIT
- End DoDot:1
- +12 USE IO
- +13 SET NURX=0
- SET ROOM=""
- FOR
- SET ROOM=$ORDER(^TMP($JOB,"NURCEN",ROOM))
- if ROOM=""!NUROUT
- QUIT
- SET BED=""
- FOR
- SET BED=$ORDER(^TMP($JOB,"NURCEN",ROOM,BED))
- if BED=""!NUROUT
- QUIT
- SET PATNAME=""
- FOR
- SET PATNAME=$ORDER(^TMP($JOB,"NURCEN",ROOM,BED,PATNAME))
- if PATNAME=""
- QUIT
- Begin DoDot:1
- +14 SET X=$GET(^TMP($JOB,"NURCEN",ROOM,BED,PATNAME))
- SET DFN=+X
- +15 IF IOSL-4<$Y!'(NURSW1)
- DO HEADER
- if NUROUT
- QUIT
- +16 WRITE !!,$$PRTRMBD(ROOM,BED),?17,PATNAME," ",$SELECT($PIECE(X,U,2)'="":"("_$PIECE(X,U,2)_")",1:"")
- +17 IF $ORDER(^TMP("NURPROB",$JOB,DFN,""))=""
- WRITE !?3,"THIS PATIENT HAS NO PROBLEMS TO BE EVALUATED."
- QUIT
- +18 SET REVDTDV=""
- FOR
- SET REVDTDV=$ORDER(^TMP("NURPROB",$JOB,DFN,REVDTDV))
- if REVDTDV=""!NUROUT
- QUIT
- FOR NURPRB=0:0
- SET NURPRB=$ORDER(^TMP("NURPROB",$JOB,DFN,REVDTDV,NURPRB))
- if NURPRB'>0
- QUIT
- Begin DoDot:2
- +19 FOR GMRGPDA=0:0
- SET GMRGPDA=$ORDER(^TMP("NURPROB",$JOB,DFN,REVDTDV,NURPRB,GMRGPDA))
- if GMRGPDA'>0
- QUIT
- Begin DoDot:3
- +20 IF IOSL-4<$Y
- DO HEADER
- if NUROUT
- QUIT
- +21 SET NURX=NURX+1
- SET X1=$GET(^TMP("NURPROB",$JOB,DFN,REVDTDV,NURPRB,GMRGPDA))
- SET GMRGXPRT=$PIECE(X1,U,2)
- SET GMRGXPRT(0)=$$SELDAT^NURCEVE2(+X1,GMRGPDA)
- SET GMRGXPRT(1)="^^1^^1"
- DO EN1^GMRGRUT2
- +22 WRITE !?3,$EXTRACT(GMRGXPRT,1,43),?48,$PIECE($GET(NURCPDT($PIECE(X1,U,4))),U,2),?68,$PIECE(X1,U,3)
- +23 QUIT
- End DoDot:3
- if NUROUT
- QUIT
- +24 QUIT
- End DoDot:2
- if NUROUT
- QUIT
- +25 QUIT
- End DoDot:1
- if NUROUT
- QUIT
- +26 WRITE !!
- END ; CLEAN UP VARIABLES
- +1 KILL ^TMP($JOB)
- FOR X="NURCHC","NURPROB"
- KILL ^TMP(X,$JOB)
- +2 DO CLOSE^NURSUT1
- DO ^NURCKILL
- +3 QUIT
- +1 IF NURSW1
- IF $EXTRACT(IOST)="C"
- DO ENDPG^NURSUT1
- SET NUROUT=$GET(NUROUT)
- if NUROUT
- QUIT
- +2 if $EXTRACT(IOST)="C"!(PAGE>1)
- WRITE @IOF
- +3 SET PAGE=PAGE+1
- SET NURSW1=1
- +4 WRITE !
- SET Y=DT
- DO DT^DIQ
- WRITE ?23,"Nursing Problems to be Evaluated",?70,"Page ",PAGE
- +5 WRITE !!,"ROOM/BED",?17,"PATIENT (PID)",!,?48,"DATE/TIME",?68,"EVALUATION",!?3,"PROBLEM TO BE EVALUATED",?48,"DEVELOPED",?68,"DATE"
- +6 WRITE !,"=============================================================================="
- +7 QUIT
- PRTRMBD(ROOM,BED) ; THIS FUNTION RETURNS THE PRINTABLE FORM OF ROOM/BED
- +1 NEW RMBD
- +2 IF ROOM'=" BLANK"
- IF BED'=" BLANK"
- SET RMBD=ROOM_"-"_BED
- +3 IF '$TEST
- IF ROOM=" BLANK"
- IF BED=" BLANK"
- SET RMBD=""
- +4 IF '$TEST
- IF ROOM=" BLANK"
- SET RMBD="-"_BED
- +5 IF '$TEST
- SET RMBD=ROOM_"-"
- +6 QUIT RMBD
