NURCPP5 ;HIRMFO/JH/RM-NURSING CARE PLAN DATA OUTPUT Part 1 ;8/29/96
;;4.0;NURSING SERVICE;;Apr 25, 1997
; This is the Patient Problem Listing,Data Processor,Output Routine
; 132 Col. Compressed print
EN1 ;
D NOW^%DTC S Y=% D D^DIQ S NURSDAT=$P(Y,":",1,2),NURSISW=1,NURSLIN("-")="",$P(NURSLIN("-"),"-",132)="-",NURSPAG=1,(NURSLCNT,NURSSW1)=0 D SPACES
S NURSMED="Diagnosis: "_$E(NURSDIAG_NURSSS,1,37),NURSDOC="Physician: "_NURSPROV
S NURSHED=$E(NURSPNAM_NURSSS,1,20)_" "_NURSSSN_" "_NURAGE_" "_$E(NURSWD_NURSSS,1,8)_" "_$E(NURSRB_NURSSS,1,10)_" "_$E(NURSREL_NURSSS,1,4)_" "_NURSMAR
;
S (NURSO,NURSO1,NURSO2)=0 F X=1:1:2 S NURSO=NURSO+1,NURSO1=NURSO1+1,NURSO2=NURSO2+1,^TMP($J,"NURSDATA",NURSO)=""
S X="Date/Stat/Init "_$S($P(NURSITHD,U,2)]"":$P(NURSITHD,U,2),1:"Patient Problem"),X=X_$E(NURSSS,1,43-$L(X))
S X(1)=$S($P(NURSITHD,U,3)]"":$P(NURSITHD,U,3),1:"Goals/Expected Outcomes"),X=X_"|"_X(1)_$E(NURSSS,1,29-$L(X(1)))_"Date/Stat/Init|"
S X(1)=$S($P(NURSITHD,U,4)]"":$P(NURSITHD,U,4),1:"Nursing Intervention/Orders"),X=X_X(1)_$E(NURSSS,1,29-$L(X(1)))_"Date/Stat/Init"
S ^TMP($J,"NURSDATA",NURSO)=X,NURSO=NURSO+1
S ^TMP($J,"NURSDATA",NURSO)=$E(NURSLIN("-"),1,43)_"|"_$E(NURSLIN("-"),1,43)_"|"_$E(NURSLIN("-"),1,44)
S NURSO=NURSO+1,^TMP($J,"NURSDATA",NURSO)=""
;
S (NURSO1,NURSO2,NURSO)=NURSO+1,NURSP(1)="" F NURSX=0:0 S NURSP(1)=$O(NURSPRB(NURSP(1))) Q:NURSP(1)="" F NURSP=0:0 S NURSP=$O(NURSPRB(NURSP(1),NURSP)) Q:NURSP'>0 D PROB^NURCPP9
S X=$E(NURSSS,1,13)_"|"_$E(NURSSS,1,29)_"|"_$E(NURSSS,1,28)_"|"_$E(NURSSS,1,14)_"|"_$E(NURSSS,1,29)_"|"_$E(NURSSS,1,14)
F X(0)=0:0 Q:$S('$D(^TMP($J,"NURSDATA",NURSO)):0,^(NURSO)="":0,X'[^(NURSO):1,1:0) K ^(NURSO) S NURSO=NURSO-1
U IO I NURSO'>3 S NURSISW=0,NURSISW1=1,ANS="" D HEADER W !,$E(NURSLIN("-"),1,132),!!,"THERE IS NO DATA FOR THIS REPORT" S NURSISW=2,NURSLCNT=NURSLCNT+3 D HEADER Q
S (NURSISW,NURSISW1)=0,ANS="" D HEADER,PRINT Q:NURSOUT S NURSISW=2 D HEADER
Q
PRINT W:$E(IOST)'="C" ! F NURSO=1:0 S NURSA=$S($D(^TMP($J,"NURSDATA",NURSO)):^TMP($J,"NURSDATA",NURSO),1:"") W !,NURSA S NURSO=$O(^TMP($J,"NURSDATA",NURSO)) Q:NURSO'>0 S NURSLCNT=NURSLCNT+1,NURSSP=1 D CHKLINE Q:NURSOUT
Q
CHKLINE D HEADER:NURSLCNT>NURSIOSL Q
;
I NURSISW W !!,$E(NURSLIN("-"),1,131),!,NURSMED,NURSH4,NURSDOC F I=0:0 S I=$O(NURSALGR(I)) Q:I'>0 W !,NURSALGR(I)
I NURSISW F K=0:0 S K=$O(NURCLEG(K)) Q:K'>0 W !,NURCLEG(K)
I NURSISW W !,$E(NURSHED,1,106),NURSH5,"["_NURSPLN_"]"," ","VAF 10-0043",! Q:NURSISW=2
I NURSISW,$E(IOST)="C" R !,"Press return to continue or ""^"" to exit: ",ANS:DTIME I ANS="^"!(ANS="^^")!'$T S NURSOUT=1 S:ANS="^^" GMRGOUT=1 Q
I NURSISW'=2 W @IOF,!,NURSDAT,?(IOM/2-($L(NURSTITL)/2+($L(NURSTITL)#2)\1)),NURSTITL,?123,"Page ",$J(NURSPAG,2),!?(IOM/2-($L(NURSTITL)/2+($L(NURSTITL)#2)\1)),$E(NURSLIN("-"),1,$L(NURSTITL)) W:NURSPAG=1 !,NURSPNAM,?30,NURSMED
I W:NURSPAG'=1 ! W:NURSPAG=1&NURSERR NURSERR(1),!,NURSERR(2),!,NURSERR(1),! S NURSPAG=NURSPAG+1,NURSLCNT=5+$S(NURSERR:3,1:0),NURSISW=1
I NURSISW1'=0,$E(IOST)'="C",NURSO>3 W ! F Y=2:1:4 I $D(^TMP($J,"NURSDATA",Y)) W !,^TMP($J,"NURSDATA",Y) S NURSLCNT=NURSLCNT+1
S NURSISW1=1
Q
SPACES S NURSH1=$E(NURSSS,1,30),NURSH2=$E(NURSSS,1,42),NURSH3=$E(NURSSS,1,49),NURSH4=$E(NURSSS,1,52),NURSH5=$E(NURSSS,1,53),NURSH6=$E(NURSSS,1,10)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCPP5 3365 printed Apr 09, 2024@21:23:22 Page 2
NURCPP5 ;HIRMFO/JH/RM-NURSING CARE PLAN DATA OUTPUT Part 1 ;8/29/96
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
+2 ; This is the Patient Problem Listing,Data Processor,Output Routine
+3 ; 132 Col. Compressed print
EN1 ;
+1 DO NOW^%DTC
SET Y=%
DO D^DIQ
SET NURSDAT=$PIECE(Y,":",1,2)
SET NURSISW=1
SET NURSLIN("-")=""
SET $PIECE(NURSLIN("-"),"-",132)="-"
SET NURSPAG=1
SET (NURSLCNT,NURSSW1)=0
DO SPACES
+2 SET NURSMED="Diagnosis: "_$EXTRACT(NURSDIAG_NURSSS,1,37)
SET NURSDOC="Physician: "_NURSPROV
+3 SET NURSHED=$EXTRACT(NURSPNAM_NURSSS,1,20)_" "_NURSSSN_" "_NURAGE_" "_$EXTRACT(NURSWD_NURSSS,1,8)_" "_$EXTRACT(NURSRB_NURSSS,1,10)_" "_$EXTRACT(NURSREL_NURSSS,1,4)_" "_NURSMAR
+4 ;
+5 SET (NURSO,NURSO1,NURSO2)=0
FOR X=1:1:2
SET NURSO=NURSO+1
SET NURSO1=NURSO1+1
SET NURSO2=NURSO2+1
SET ^TMP($JOB,"NURSDATA",NURSO)=""
+6 SET X="Date/Stat/Init "_$SELECT($PIECE(NURSITHD,U,2)]"":$PIECE(NURSITHD,U,2),1:"Patient Problem")
SET X=X_$EXTRACT(NURSSS,1,43-$LENGTH(X))
+7 SET X(1)=$SELECT($PIECE(NURSITHD,U,3)]"":$PIECE(NURSITHD,U,3),1:"Goals/Expected Outcomes")
SET X=X_"|"_X(1)_$EXTRACT(NURSSS,1,29-$LENGTH(X(1)))_"Date/Stat/Init|"
+8 SET X(1)=$SELECT($PIECE(NURSITHD,U,4)]"":$PIECE(NURSITHD,U,4),1:"Nursing Intervention/Orders")
SET X=X_X(1)_$EXTRACT(NURSSS,1,29-$LENGTH(X(1)))_"Date/Stat/Init"
+9 SET ^TMP($JOB,"NURSDATA",NURSO)=X
SET NURSO=NURSO+1
+10 SET ^TMP($JOB,"NURSDATA",NURSO)=$EXTRACT(NURSLIN("-"),1,43)_"|"_$EXTRACT(NURSLIN("-"),1,43)_"|"_$EXTRACT(NURSLIN("-"),1,44)
+11 SET NURSO=NURSO+1
SET ^TMP($JOB,"NURSDATA",NURSO)=""
+12 ;
+13 SET (NURSO1,NURSO2,NURSO)=NURSO+1
SET NURSP(1)=""
FOR NURSX=0:0
SET NURSP(1)=$ORDER(NURSPRB(NURSP(1)))
if NURSP(1)=""
QUIT
FOR NURSP=0:0
SET NURSP=$ORDER(NURSPRB(NURSP(1),NURSP))
if NURSP'>0
QUIT
DO PROB^NURCPP9
+14 SET X=$EXTRACT(NURSSS,1,13)_"|"_$EXTRACT(NURSSS,1,29)_"|"_$EXTRACT(NURSSS,1,28)_"|"_$EXTRACT(NURSSS,1,14)_"|"_$EXTRACT(NURSSS,1,29)_"|"_$EXTRACT(NURSSS,1,14)
+15 FOR X(0)=0:0
if $SELECT('$DATA(^TMP($JOB,"NURSDATA",NURSO))
QUIT
KILL ^(NURSO)
SET NURSO=NURSO-1
+16 USE IO
IF NURSO'>3
SET NURSISW=0
SET NURSISW1=1
SET ANS=""
DO HEADER
WRITE !,$EXTRACT(NURSLIN("-"),1,132),!!,"THERE IS NO DATA FOR THIS REPORT"
SET NURSISW=2
SET NURSLCNT=NURSLCNT+3
DO HEADER
QUIT
+17 SET (NURSISW,NURSISW1)=0
SET ANS=""
DO HEADER
DO PRINT
if NURSOUT
QUIT
SET NURSISW=2
DO HEADER
+18 QUIT
PRINT if $EXTRACT(IOST)'="C"
WRITE !
FOR NURSO=1:0
SET NURSA=$SELECT($DATA(^TMP($JOB,"NURSDATA",NURSO)):^TMP($JOB,"NURSDATA",NURSO),1:"")
WRITE !,NURSA
SET NURSO=$ORDER(^TMP($JOB,"NURSDATA",NURSO))
if NURSO'>0
QUIT
SET NURSLCNT=NURSLCNT+1
SET NURSSP=1
DO CHKLINE
if NURSOUT
QUIT
+1 QUIT
CHKLINE if NURSLCNT>NURSIOSL
DO HEADER
QUIT
+1 ;
SET NURSEND=IOSL-11
FOR X=NURSLCNT:1:NURSEND
WRITE !
+1 IF NURSISW
WRITE !!,$EXTRACT(NURSLIN("-"),1,131),!,NURSMED,NURSH4,NURSDOC
FOR I=0:0
SET I=$ORDER(NURSALGR(I))
if I'>0
QUIT
WRITE !,NURSALGR(I)
+2 IF NURSISW
FOR K=0:0
SET K=$ORDER(NURCLEG(K))
if K'>0
QUIT
WRITE !,NURCLEG(K)
+3 IF NURSISW
WRITE !,$EXTRACT(NURSHED,1,106),NURSH5,"["_NURSPLN_"]"," ","VAF 10-0043",!
if NURSISW=2
QUIT
+4 IF NURSISW
IF $EXTRACT(IOST)="C"
READ !,"Press return to continue or ""^"" to exit: ",ANS:DTIME
IF ANS="^"!(ANS="^^")!'$TEST
SET NURSOUT=1
if ANS="^^"
SET GMRGOUT=1
QUIT
+5 IF NURSISW'=2
WRITE @IOF,!,NURSDAT,?(IOM/2-($LENGTH(NURSTITL)/2+($LENGTH(NURSTITL)#2)\1)),NURSTITL,?123,"Page ",$JUSTIFY(NURSPAG,2),!?(IOM/2-($LENGTH(NURSTITL)/2+($LENGTH(NURSTITL)#2)\1)),$EXTRACT(NURSLIN("-"),1,$LENGTH(NURSTITL))
if NURSPAG=1
WRITE !,NURSPNAM,?30,NURSMED
+6 IF $TEST
if NURSPAG'=1
WRITE !
if NURSPAG=1&NURSERR
WRITE NURSERR(1),!,NURSERR(2),!,NURSERR(1),!
SET NURSPAG=NURSPAG+1
SET NURSLCNT=5+$SELECT(NURSERR:3,1:0)
SET NURSISW=1
+7 IF NURSISW1'=0
IF $EXTRACT(IOST)'="C"
IF NURSO>3
WRITE !
FOR Y=2:1:4
IF $DATA(^TMP($JOB,"NURSDATA",Y))
WRITE !,^TMP($JOB,"NURSDATA",Y)
SET NURSLCNT=NURSLCNT+1
+8 SET NURSISW1=1
+9 QUIT
SPACES SET NURSH1=$EXTRACT(NURSSS,1,30)
SET NURSH2=$EXTRACT(NURSSS,1,42)
SET NURSH3=$EXTRACT(NURSSS,1,49)
SET NURSH4=$EXTRACT(NURSSS,1,52)
SET NURSH5=$EXTRACT(NURSSS,1,53)
SET NURSH6=$EXTRACT(NURSSS,1,10)
+1 QUIT
