- 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 Mar 13, 2025@21:25:43 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
