Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: NURCPP3

NURCPP3.m

Go to the documentation of this file.
  1. NURCPP3 ;HIRMFO/JH/RM-NURSING CARE PLAN DATA OUTPUT part 3 ;1/11/92
  1. ;;4.0;NURSING SERVICE;;Apr 25, 1997
  1. ; This is the Patient Problem Listing,Data Processor,Output Routine
  1. ;
  1. GETOUPT ;Print Patient Care Plan Data and Affiliated Dates.
  1. S NURSISW=0,ANS="" D HEADER,PRINT Q:NURSOUT S NURSISW=2 D HEADER
  1. Q
  1. 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
  1. Q
  1. CHKLINE D HEADER:NURSLCNT>NURSIOSL Q
  1. ;
  1. I NURSISW W !!,$E(NURSLIN("-"),1,80),!,NURSMED F I=0:0 S I=$O(NURSALGR(I)) Q:I'>0 W !,NURSALGR(I)
  1. I NURSISW F K=0:0 S K=$O(NURCLEG(K)) Q:K'>0 W !,NURCLEG(K)
  1. I NURSISW W !,NURSHED,?65,"["_NURSPLN_"]",?69,"VAF 10-0043",! Q:NURSISW=2
  1. 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
  1. I NURSISW'=2 W @IOF,!,NURSDAT,?(IOM/2-($L(NURSTITL)/2+($L(NURSTITL)#2)\1)),NURSTITL,?71,"PAGE ",NURSPAG
  1. 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)
  1. Q
  1. SPACES S NURSP3=" "
  1. S NURSP1=" ",NURSP2=" ",NURSP3=" ",NURSH1=" ",NURSH2=" ",NURSH3=" ",NURSH4=$E(NURSSS,1,60),NURSH5=$E(NURSSS,1,10),NURSH6="",NURSH7=$E(NURSSS,1,28) Q