source: WorldVistAEHR/trunk/r/NURSING_SERVICE-NUR/NURCPP9.m@ 1780

Last change on this file since 1780 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.5 KB
Line 
1NURCPP9 ;HIRMFO/JH/RM-NURSING CARE PLAN DATA OUTPUT Part 1 ;1/13/92
2 ;;4.0;NURSING SERVICE;;Apr 25, 1997
3 ; This is the Patient Problem Listing,Data Processor,Output Routine
4 ; 132 Col. Compressed print
5PROB ; CHECK FOR PROBLEM AND EVALUATION DATE
6 S GMRGXPRT=$S($D(^GMRD(124.2,NURSP,0)):$P(^(0),"^"),1:""),NURSP(0)=$O(^GMR(124.3,GMRGPDA,1,"B",NURSP,0)),GMRGXPRT(0)=$S(NURSP(0)'>0:"",$D(^GMR(124.3,GMRGPDA,1,NURSP(0),0)):$P(^(0),"^",2),1:""),GMRGXPRT(1)="^^0^^1" D EN1^GMRGRUT2
7 S GMRGPLN=GMRGXPRT,GMRGLEN=29,NURSTI=1 D FITLINE^GMRGRUT1
8 F NURSE(0)=0:0 S NURSE(0)=$O(^TMP($J,"NURSDATE",NURSP,NURSE(0))) Q:NURSE(0)'>0 F NURSE=0:0 S NURSE=$O(^TMP($J,"NURSDATE",NURSP,NURSE(0),NURSE)) Q:NURSE'>0 D PROB1
9 F NURSE=0:0 Q:GMRGPLN(0)="" S NURS=$E(NURSSS,1,13)_"|"_$E(GMRGPLN(0)_NURSSS,1,29),NURS(0)=0,NURS(1)=NURSO D X^NURCPP8 S NURSO=NURSO+1,NURS="",NURS(0)=0,NURS(1)=NURSO D X^NURCPP8 S GMRGLEN=26,GMRGPLN=GMRGPLN(1) D FITLINE^GMRGRUT1
10 G PROB3
11 ;
12PROB1 ;
13 S X=$S($D(^TMP($J,"NURSDATE",NURSP,NURSE(0),NURSE)):^(NURSE),1:"")
14 S Y=$P(X,"^",2) S:Y'="" Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
15 S NURSTAT=$S($L($P(X,"^",4)):"("_$P(X,"^",4)_")",1:" "),NURSRN=$E($S($D(^VA(200,+$P(X,"^",3),0)):$E($P($P(^(0),"^"),",",2))_$E($P($P(^(0),"^"),",")),1:"")_" ",1,2)
16 S NURS=Y_NURSTAT_NURSRN_"|"_$E(GMRGPLN(0)_NURSSS,1,29),NURS(0)=0,NURS(1)=NURSO D X^NURCPP8 S NURSO=NURSO+1,GMRGPLN(0)="",NURS="",NURS(0)=0,NURS(1)=NURSO D X^NURCPP8
17 I GMRGPLN(1)'="" S GMRGPLN=GMRGPLN(1),GMRGLEN=26 D FITLINE^GMRGRUT1
18 Q
19PROB3 F NURSOT=0:0 S NURSOT=$O(^TMP($J,"NURSOT",NURSP,NURSOT)) Q:NURSOT'>0 S NURS="",NURS(0)=0,NURS(1)=NURSO D X^NURCPP8 D OTHER
20 ;
21 I $D(^TMP($J,"NURSDATA",NURSO)),^(NURSO)'="" S NURSO=NURSO+1
22 K NURSB("G"),NURSB("I") F NURSE=0:0 S NURSE=$O(^GMRD(124.2,NURSP,1,"B",NURSE)) Q:NURSE'>0 S NURSE(0)=$S($D(^GMRD(124.2,NURSE,0)):$P(^(0),"^",4),1:"") S:NURSE(0)=NURSGCK NURSB("G",NURSE)="" S:NURSE(0)=NURSICK NURSB("I",NURSE)=""
23 D ^NURCPP6
24 S NURSP(0)=$O(^GMR(124.3,GMRGPDA,1,"B",NURSP,0)) I NURSP(0)>0,$D(^GMR(124.3,GMRGPDA,1,NURSP(0),"ADD")),^("ADD")]"" S NURSLGT=29,NURSRET=3,NURSADD=^("ADD"),NURSO2=NURSO2+1,NURSO4=NURSO2 D FORMAT^NURCPP7 S NURSO2=NURSO4
25 ;
26 S X=$S(NURSO2>NURSO1:NURSO2,1:NURSO1),X=$S(X>NURSO:X,1:NURSO),(NURSO,NURSO1,NURSO2)=X F NURSE=1:1:2 S NURSO=NURSO+1,NURSO1=NURSO1+1,NURSO2=NURSO2+1,NURS="",NURS(0)=0,NURS(1)=NURSO D X^NURCPP8
27 Q
28 ;
29OTHER ; PRINT OTHER INFO ABOUT PROBLEM
30 F NURST=0:0 S NURST=$O(^TMP($J,"GMRGNAR","R",NURSOT,NURST)) Q:NURST'>0 D STOT
31 Q
32STOT ;
33 S X=^TMP($J,"GMRGNAR","R",NURSOT,NURST)
34 S NURS=$E(NURSSS,1,13)_"|"_X,NURS(0)=0,NURS(1)=NURSO D X^NURCPP8 S NURSO=NURSO+1
35 Q
Note: See TracBrowser for help on using the repository browser.