- NURCCP4 ;HIRMFO/RM,RTK-STANDARD CARE PLAN PRINT (print data) ;8/29/96
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- PRINT ; BEGIN PRINTING THIS DOCUMENT
- S NURCTYPE=+$O(^GMRD(124.25,"AA","NURSC","GOALS/EXPECTED OUTCOMES",0))_"^"_+$O(^GMRD(124.25,"AA","NURSC","NURSING INTERVENTION",0))_"^"_+$O(^GMRD(124.25,"AA","NURSC","RELATED FACTOR",0))_"^"_+$O(^GMRD(124.25,"AA","NURSC","RELATED PROBLEM",0))
- S NURCTYPE=NURCTYPE_"^"_+$O(^GMRD(124.25,"AA","NURSC","DEFINING CHARACTERISTICS",0))
- S NURCOUT=0,NURCEOPG=$S(IOSL-4>0:IOSL-4,1:20)
- S NURCTEXT=$O(^TMP($J,"LVL",+NURCRT,"")),NURCSECT=0 I NURCTEXT'="" S NURCSECT=+$O(^TMP($J,"LVL",+NURCRT,NURCTEXT,0))
- S NURCSECT=$G(^TMP($J,"LVL",+NURCRT,NURCTEXT,NURCSECT)),NURCTITL="Patient Plan of Care Content by "_$P(NURCSECT,"^",2),NURCPG=1,NURSDASH="",$P(NURSDASH,"-",IOM+1)=""
- U IO S SPC=0,NURCSECT=+NURCSECT D HDR,PRNTP
- Q
- PRNTP ; PRINT CHILDREN UNDER PARENT, AND THEN RECURSIVLY CALL THIS
- ; PROCEDURE FOR THOSE CHILDREN
- S PARENT=NURCSECT N NURCSECT
- S TXT="" F S TXT=$O(^TMP($J,"LVL",PARENT,TXT)) Q:TXT=""!NURCOUT F CHILD=0:0 S CHILD=$O(^TMP($J,"LVL",PARENT,TXT,CHILD)) Q:CHILD'>0 D PRTLVL Q:NURCOUT
- Q:NURCOUT S TXT="" F S TXT=$O(^TMP($J,"PROB",PARENT,TXT)) Q:TXT=""!NURCOUT F CHILD=0:0 S CHILD=$O(^TMP($J,"PROB",PARENT,TXT,CHILD)) Q:CHILD'>0 D PRPROB Q:NURCOUT
- Q
- PRPROB ; CONTINUATION OF FOR LOOP IN LINE PRNTP+4
- S NURCSECT=CHILD,NURCSECT(0)=TXT,NURCSECT(1)=PARENT D PROB S CHILD=NURCSECT,TXT=NURCSECT(0),PARENT=NURCSECT(1)
- Q
- PRTLVL ; CONTINUATION OF FOR LOOP IN LINE PRNTP+3
- D HDR:NURCEOPG<$Y Q:NURCOUT
- S X=$G(^TMP($J,"LVL",PARENT,TXT,CHILD)) W !!,?SPC,$P(X,"^",2)
- S SPC=SPC+3,NURCSECT=+X,NURCSECT(0)=CHILD,NURCSECT(1)=TXT,NURCSECT(2)=PARENT D PRNTP S SPC=SPC-3,CHILD=NURCSECT(0),TXT=NURCSECT(1),PARENT=NURCSECT(2)
- Q
- PROB ; PRINT TERM NODE, AND THEN RECURSIVELY CALL THIS ROUTINES FOR
- ; NODE'S CHILDREN
- S NODE=NURCSECT N NURCSECT,Q
- S X=$G(^GMRD(124.2,NODE,0))
- S Q=0 I $D(^GMRD(124.2,CHILD,1,"B",NODE)),'$G(NURCPDAT(6)) S Q=1 D Q:Q
- . F XXX=1:1:5 I +$G(NURCPDAT(XXX)),$P(X,"^",4)=$P(NURCTYPE,"^",+NURCPDAT(XXX)) S Q=0
- . Q
- D HDR:NURCEOPG<$Y Q:NURCOUT
- W:'$D(NURCPDAT(7))&(NODE=CHILD) ! W !?SPC,$P(X,"^") Q:$D(NURCPDAT(7))
- S X="" F S X=$O(^GMRD(124.2,NODE,1,"AC",X)) Q:X=""!NURCOUT F Y=0:0 S Y=$O(^GMRD(124.2,NODE,1,"AC",X,Y)) Q:Y'>0 D PROB1 Q:NURCOUT
- Q
- PROB1 ; CONTINUATION OF FOR LOOP IN LINE PROB+7
- S Z=$G(^GMRD(124.2,NODE,1,Y,0)) S SPC=SPC+3,NURCSECT=+Z,NURCSECT(0)=X,NURCSECT(1)=Y,NURCSECT(2)=NODE D PROB S SPC=SPC-3,X=NURCSECT(0),Y=NURCSECT(1),NODE=NURCSECT(2)
- Q
- HDR ;
- N X
- I $E(IOST)="C",NURCPG>1 D ENDPG^NURSUT1 S NURCOUT=$G(NUROUT) Q:NURCOUT I "^^"'[X W !?4,"ENTER <RET> TO CONTINUE WITH THIS REPORT, ^ TO EXIT." G HDR
- W:$E(IOST)="C"!(NURCPG>1) @IOF W !,?($P(IOM/2,".")-$P($L(NURCTITL)/2,".")),NURCTITL,?(IOM-9),"PAGE: ",NURCPG,!,NURSDASH S NURCPG=NURCPG+1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCCP4 2881 printed Jan 18, 2025@03:21:23 Page 2
- NURCCP4 ;HIRMFO/RM,RTK-STANDARD CARE PLAN PRINT (print data) ;8/29/96
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- PRINT ; BEGIN PRINTING THIS DOCUMENT
- +1 SET NURCTYPE=+$ORDER(^GMRD(124.25,"AA","NURSC","GOALS/EXPECTED OUTCOMES",0))_"^"_+$ORDER(^GMRD(124.25,"AA","NURSC","NURSING INTERVENTION",0))_"^"_+...
- ... $ORDER(^GMRD(124.25,"AA","NURSC","RELATED FACTOR",0))_"^"_+$ORDER(^GMRD(124.25,"AA","NURSC","RELATED PROBLEM",0))
- +2 SET NURCTYPE=NURCTYPE_"^"_+$ORDER(^GMRD(124.25,"AA","NURSC","DEFINING CHARACTERISTICS",0))
- +3 SET NURCOUT=0
- SET NURCEOPG=$SELECT(IOSL-4>0:IOSL-4,1:20)
- +4 SET NURCTEXT=$ORDER(^TMP($JOB,"LVL",+NURCRT,""))
- SET NURCSECT=0
- IF NURCTEXT'=""
- SET NURCSECT=+$ORDER(^TMP($JOB,"LVL",+NURCRT,NURCTEXT,0))
- +5 SET NURCSECT=$GET(^TMP($JOB,"LVL",+NURCRT,NURCTEXT,NURCSECT))
- SET NURCTITL="Patient Plan of Care Content by "_$PIECE(NURCSECT,"^",2)
- SET NURCPG=1
- SET NURSDASH=""
- SET $PIECE(NURSDASH,"-",IOM+1)=""
- +6 USE IO
- SET SPC=0
- SET NURCSECT=+NURCSECT
- DO HDR
- DO PRNTP
- +7 QUIT
- PRNTP ; PRINT CHILDREN UNDER PARENT, AND THEN RECURSIVLY CALL THIS
- +1 ; PROCEDURE FOR THOSE CHILDREN
- +2 SET PARENT=NURCSECT
- NEW NURCSECT
- +3 SET TXT=""
- FOR
- SET TXT=$ORDER(^TMP($JOB,"LVL",PARENT,TXT))
- if TXT=""!NURCOUT
- QUIT
- FOR CHILD=0:0
- SET CHILD=$ORDER(^TMP($JOB,"LVL",PARENT,TXT,CHILD))
- if CHILD'>0
- QUIT
- DO PRTLVL
- if NURCOUT
- QUIT
- +4 if NURCOUT
- QUIT
- SET TXT=""
- FOR
- SET TXT=$ORDER(^TMP($JOB,"PROB",PARENT,TXT))
- if TXT=""!NURCOUT
- QUIT
- FOR CHILD=0:0
- SET CHILD=$ORDER(^TMP($JOB,"PROB",PARENT,TXT,CHILD))
- if CHILD'>0
- QUIT
- DO PRPROB
- if NURCOUT
- QUIT
- +5 QUIT
- PRPROB ; CONTINUATION OF FOR LOOP IN LINE PRNTP+4
- +1 SET NURCSECT=CHILD
- SET NURCSECT(0)=TXT
- SET NURCSECT(1)=PARENT
- DO PROB
- SET CHILD=NURCSECT
- SET TXT=NURCSECT(0)
- SET PARENT=NURCSECT(1)
- +2 QUIT
- PRTLVL ; CONTINUATION OF FOR LOOP IN LINE PRNTP+3
- +1 if NURCEOPG<$Y
- DO HDR
- if NURCOUT
- QUIT
- +2 SET X=$GET(^TMP($JOB,"LVL",PARENT,TXT,CHILD))
- WRITE !!,?SPC,$PIECE(X,"^",2)
- +3 SET SPC=SPC+3
- SET NURCSECT=+X
- SET NURCSECT(0)=CHILD
- SET NURCSECT(1)=TXT
- SET NURCSECT(2)=PARENT
- DO PRNTP
- SET SPC=SPC-3
- SET CHILD=NURCSECT(0)
- SET TXT=NURCSECT(1)
- SET PARENT=NURCSECT(2)
- +4 QUIT
- PROB ; PRINT TERM NODE, AND THEN RECURSIVELY CALL THIS ROUTINES FOR
- +1 ; NODE'S CHILDREN
- +2 SET NODE=NURCSECT
- NEW NURCSECT,Q
- +3 SET X=$GET(^GMRD(124.2,NODE,0))
- +4 SET Q=0
- IF $DATA(^GMRD(124.2,CHILD,1,"B",NODE))
- IF '$GET(NURCPDAT(6))
- SET Q=1
- Begin DoDot:1
- +5 FOR XXX=1:1:5
- IF +$GET(NURCPDAT(XXX))
- IF $PIECE(X,"^",4)=$PIECE(NURCTYPE,"^",+NURCPDAT(XXX))
- SET Q=0
- +6 QUIT
- End DoDot:1
- if Q
- QUIT
- +7 if NURCEOPG<$Y
- DO HDR
- if NURCOUT
- QUIT
- +8 if '$DATA(NURCPDAT(7))&(NODE=CHILD)
- WRITE !
- WRITE !?SPC,$PIECE(X,"^")
- if $DATA(NURCPDAT(7))
- QUIT
- +9 SET X=""
- FOR
- SET X=$ORDER(^GMRD(124.2,NODE,1,"AC",X))
- if X=""!NURCOUT
- QUIT
- FOR Y=0:0
- SET Y=$ORDER(^GMRD(124.2,NODE,1,"AC",X,Y))
- if Y'>0
- QUIT
- DO PROB1
- if NURCOUT
- QUIT
- +10 QUIT
- PROB1 ; CONTINUATION OF FOR LOOP IN LINE PROB+7
- +1 SET Z=$GET(^GMRD(124.2,NODE,1,Y,0))
- SET SPC=SPC+3
- SET NURCSECT=+Z
- SET NURCSECT(0)=X
- SET NURCSECT(1)=Y
- SET NURCSECT(2)=NODE
- DO PROB
- SET SPC=SPC-3
- SET X=NURCSECT(0)
- SET Y=NURCSECT(1)
- SET NODE=NURCSECT(2)
- +2 QUIT
- HDR ;
- +1 NEW X
- +2 IF $EXTRACT(IOST)="C"
- IF NURCPG>1
- DO ENDPG^NURSUT1
- SET NURCOUT=$GET(NUROUT)
- if NURCOUT
- QUIT
- IF "^^"'[X
- WRITE !?4,"ENTER <RET> TO CONTINUE WITH THIS REPORT, ^ TO EXIT."
- GOTO HDR
- +3 if $EXTRACT(IOST)="C"!(NURCPG>1)
- WRITE @IOF
- WRITE !,?($PIECE(IOM/2,".")-$PIECE($LENGTH(NURCTITL)/2,".")),NURCTITL,?(IOM-9),"PAGE: ",NURCPG,!,NURSDASH
- SET NURCPG=NURCPG+1
- +4 QUIT