NURCPP3 ;HIRMFO/JH/RM-NURSING CARE PLAN DATA OUTPUT part 3 ;1/11/92
;;4.0;NURSING SERVICE;;Apr 25, 1997
; This is the Patient Problem Listing,Data Processor,Output Routine
;
GETOUPT ;Print Patient Care Plan Data and Affiliated Dates.
S NURSISW=0,ANS="" D HEADER,PRINT Q:NURSOUT S NURSISW=2 D HEADER
Q
PRINT W ! F NURSO=0:0 S NURSO=$O(^TMP($J,"NURSDATA",NURSO)) Q:NURSO'>0 S NURSA=$S($D(^TMP($J,"NURSDATA",NURSO)):^TMP($J,"NURSDATA",NURSO),1:"") D:NURSISW CHKLINE Q:NURSOUT W !,NURSA S NURSLCNT=NURSLCNT+1,NURSSP=1,NURSISW=1
Q
CHKLINE D HEADER:NURSLCNT>NURSIOSL Q
;
I NURSISW W !!,$E(NURSLIN("-"),1,80),!,NURSMED 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 !,NURSHED,?65,"["_NURSPLN_"]",?69,"VAF 10-0043",! Q:NURSISW=2
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,?71,"PAGE ",NURSPAG
I W:NURSPAG=1&NURSERR !,NURSERR(1),!,NURSERR(2),!,NURSERR(1) W !,$E(NURSLIN("-"),1,80),!,NURSH4,"Date R.N." S NURSPAG=NURSPAG+1,NURSLCNT=5+$S(NURSERR:3,1:0)
Q
SPACES S NURSP3=" "
S NURSP1=" ",NURSP2=" ",NURSP3=" ",NURSH1=" ",NURSH2=" ",NURSH3=" ",NURSH4=$E(NURSSS,1,60),NURSH5=$E(NURSSS,1,10),NURSH6="",NURSH7=$E(NURSSS,1,28) Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCPP3 1496 printed Dec 13, 2024@02:20:39 Page 2
NURCPP3 ;HIRMFO/JH/RM-NURSING CARE PLAN DATA OUTPUT part 3 ;1/11/92
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
+2 ; This is the Patient Problem Listing,Data Processor,Output Routine
+3 ;
GETOUPT ;Print Patient Care Plan Data and Affiliated Dates.
+1 SET NURSISW=0
SET ANS=""
DO HEADER
DO PRINT
if NURSOUT
QUIT
SET NURSISW=2
DO HEADER
+2 QUIT
PRINT WRITE !
FOR NURSO=0:0
SET NURSO=$ORDER(^TMP($JOB,"NURSDATA",NURSO))
if NURSO'>0
QUIT
SET NURSA=$SELECT($DATA(^TMP($JOB,"NURSDATA",NURSO)):^TMP($JOB,"NURSDATA",NURSO),1:"")
if NURSISW
DO CHKLINE
if NURSOUT
QUIT
WRITE !,NURSA
SET NURSLCNT=NURSLCNT+1
SET NURSSP=1
SET NURSISW=1
+1 QUIT
CHKLINE if NURSLCNT>NURSIOSL
DO HEADER
QUIT
+1 ;
SET NURSEND=IOSL-9
FOR X=NURSLCNT:1:NURSEND
WRITE !
+1 IF NURSISW
WRITE !!,$EXTRACT(NURSLIN("-"),1,80),!,NURSMED
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 !,NURSHED,?65,"["_NURSPLN_"]",?69,"VAF 10-0043",!
if NURSISW=2
QUIT
+4 if NURSISW=2
QUIT
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,?71,"PAGE ",NURSPAG
+6 IF $TEST
if NURSPAG=1&NURSERR
WRITE !,NURSERR(1),!,NURSERR(2),!,NURSERR(1)
WRITE !,$EXTRACT(NURSLIN("-"),1,80),!,NURSH4,"Date R.N."
SET NURSPAG=NURSPAG+1
SET NURSLCNT=5+$SELECT(NURSERR:3,1:0)
+7 QUIT
SPACES SET NURSP3=" "
+1 SET NURSP1=" "
SET NURSP2=" "
SET NURSP3=" "
SET NURSH1=" "
SET NURSH2=" "
SET NURSH3=" "
SET NURSH4=$EXTRACT(NURSSS,1,60)
SET NURSH5=$EXTRACT(NURSSS,1,10)
SET NURSH6=""
SET NURSH7=$EXTRACT(NURSSS,1,28)
QUIT
