- 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 Jan 18, 2025@03:21:49 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