- NURCPP9 ;HIRMFO/JH/RM-NURSING CARE PLAN DATA OUTPUT Part 1 ;1/13/92
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- ; This is the Patient Problem Listing,Data Processor,Output Routine
- ; 132 Col. Compressed print
- PROB ; CHECK FOR PROBLEM AND EVALUATION DATE
- 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
- S GMRGPLN=GMRGXPRT,GMRGLEN=29,NURSTI=1 D FITLINE^GMRGRUT1
- 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
- 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
- G PROB3
- ;
- PROB1 ;
- S X=$S($D(^TMP($J,"NURSDATE",NURSP,NURSE(0),NURSE)):^(NURSE),1:"")
- S Y=$P(X,"^",2) S:Y'="" Y=$E(Y,4,5)_"/"_$E(Y,6,7)_"/"_$E(Y,2,3)
- 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)
- 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
- I GMRGPLN(1)'="" S GMRGPLN=GMRGPLN(1),GMRGLEN=26 D FITLINE^GMRGRUT1
- Q
- PROB3 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
- ;
- I $D(^TMP($J,"NURSDATA",NURSO)),^(NURSO)'="" S NURSO=NURSO+1
- 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)=""
- D ^NURCPP6
- 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
- ;
- 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
- Q
- ;
- OTHER ; PRINT OTHER INFO ABOUT PROBLEM
- F NURST=0:0 S NURST=$O(^TMP($J,"GMRGNAR","R",NURSOT,NURST)) Q:NURST'>0 D STOT
- Q
- STOT ;
- S X=^TMP($J,"GMRGNAR","R",NURSOT,NURST)
- S NURS=$E(NURSSS,1,13)_"|"_X,NURS(0)=0,NURS(1)=NURSO D X^NURCPP8 S NURSO=NURSO+1
- Q
- NURCPP9 ;HIRMFO/JH/RM-NURSING CARE PLAN DATA OUTPUT Part 1 ;1/13/92
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- +2 ; This is the Patient Problem Listing,Data Processor,Output Routine
- +3 ; 132 Col. Compressed print
- PROB ; CHECK FOR PROBLEM AND EVALUATION DATE
- +1 SET GMRGXPRT=$SELECT($DATA(^GMRD(124.2,NURSP,0)):$PIECE(^(0),"^"),1:"")
- SET NURSP(0)=$ORDER(^GMR(124.3,GMRGPDA,1,"B",NURSP,0))
- SET GMRGXPRT(0)=$SELECT(NURSP(0)'>0:"",$DATA(^GMR(124.3,GMRGPDA,1,NURSP(0),0)):$PIECE(^(0),"^",2),1:"")
- SET GMRGXPRT(1)="^^0^^1"
- DO EN1^GMRGRUT2
- +2 SET GMRGPLN=GMRGXPRT
- SET GMRGLEN=29
- SET NURSTI=1
- DO FITLINE^GMRGRUT1
- +3 FOR NURSE(0)=0:0
- SET NURSE(0)=$ORDER(^TMP($JOB,"NURSDATE",NURSP,NURSE(0)))
- IF NURSE(0)'>0
- QUIT
- FOR NURSE=0:0
- SET NURSE=$ORDER(^TMP($JOB,"NURSDATE",NURSP,NURSE(0),NURSE))
- IF NURSE'>0
- QUIT
- DO PROB1
- +4 FOR NURSE=0:0
- IF GMRGPLN(0)=""
- QUIT
- SET NURS=$EXTRACT(NURSSS,1,13)_"|"_$EXTRACT(GMRGPLN(0)_NURSSS,1,29)
- SET NURS(0)=0
- SET NURS(1)=NURSO
- DO X^NURCPP8
- SET NURSO=NURSO+1
- SET NURS=""
- SET NURS(0)=0
- SET NURS(1)=NURSO
- DO X^NURCPP8
- SET GMRGLEN=26
- SET GMRGPLN=GMRGPLN(1)
- DO FITLINE^GMRGRUT1
- +5 GOTO PROB3
- +6 ;
- PROB1 ;
- +1 SET X=$SELECT($DATA(^TMP($JOB,"NURSDATE",NURSP,NURSE(0),NURSE)):^(NURSE),1:"")
- +2 SET Y=$PIECE(X,"^",2)
- IF Y'=""
- SET Y=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
- +3 SET NURSTAT=$SELECT($LENGTH($PIECE(X,"^",4)):"("_$PIECE(X,"^",4)_")",1:" ")
- SET NURSRN=$EXTRACT($SELECT($DATA(^VA(200,+$PIECE(X,"^",3),0)):$EXTRACT($PIECE($PIECE(^(0),"^"),",",2))_$EXTRACT($PIECE($PIECE(^(0),"^"),",")),1:"")_" ",1,2)
- +4 SET NURS=Y_NURSTAT_NURSRN_"|"_$EXTRACT(GMRGPLN(0)_NURSSS,1,29)
- SET NURS(0)=0
- SET NURS(1)=NURSO
- DO X^NURCPP8
- SET NURSO=NURSO+1
- SET GMRGPLN(0)=""
- SET NURS=""
- SET NURS(0)=0
- SET NURS(1)=NURSO
- DO X^NURCPP8
- +5 IF GMRGPLN(1)'=""
- SET GMRGPLN=GMRGPLN(1)
- SET GMRGLEN=26
- DO FITLINE^GMRGRUT1
- +6 QUIT
- PROB3 FOR NURSOT=0:0
- SET NURSOT=$ORDER(^TMP($JOB,"NURSOT",NURSP,NURSOT))
- IF NURSOT'>0
- QUIT
- SET NURS=""
- SET NURS(0)=0
- SET NURS(1)=NURSO
- DO X^NURCPP8
- DO OTHER
- +1 ;
- +2 IF $DATA(^TMP($JOB,"NURSDATA",NURSO))
- IF ^(NURSO)'=""
- SET NURSO=NURSO+1
- +3 KILL NURSB("G"),NURSB("I")
- FOR NURSE=0:0
- SET NURSE=$ORDER(^GMRD(124.2,NURSP,1,"B",NURSE))
- IF NURSE'>0
- QUIT
- SET NURSE(0)=$SELECT($DATA(^GMRD(124.2,NURSE,0)):$PIECE(^(0),"^",4),1:"")
- IF NURSE(0)=NURSGCK
- SET NURSB("G",NURSE)=""
- IF NURSE(0)=NURSICK
- SET NURSB("I",NURSE)=""
- +4 DO ^NURCPP6
- +5 SET NURSP(0)=$ORDER(^GMR(124.3,GMRGPDA,1,"B",NURSP,0))
- IF NURSP(0)>0
- IF $DATA(^GMR(124.3,GMRGPDA,1,NURSP(0),"ADD"))
- IF ^("ADD")]""
- SET NURSLGT=29
- SET NURSRET=3
- SET NURSADD=^("ADD")
- SET NURSO2=NURSO2+1
- SET NURSO4=NURSO2
- DO FORMAT^NURCPP7
- SET NURSO2=NURSO4
- +6 ;
- +7 SET X=$SELECT(NURSO2>NURSO1:NURSO2,1:NURSO1)
- SET X=$SELECT(X>NURSO:X,1:NURSO)
- SET (NURSO,NURSO1,NURSO2)=X
- FOR NURSE=1:1:2
- SET NURSO=NURSO+1
- SET NURSO1=NURSO1+1
- SET NURSO2=NURSO2+1
- SET NURS=""
- SET NURS(0)=0
- SET NURS(1)=NURSO
- DO X^NURCPP8
- +8 QUIT
- +9 ;
- OTHER ; PRINT OTHER INFO ABOUT PROBLEM
- +1 FOR NURST=0:0
- SET NURST=$ORDER(^TMP($JOB,"GMRGNAR","R",NURSOT,NURST))
- IF NURST'>0
- QUIT
- DO STOT
- +2 QUIT
- STOT ;
- +1 SET X=^TMP($JOB,"GMRGNAR","R",NURSOT,NURST)
- +2 SET NURS=$EXTRACT(NURSSS,1,13)_"|"_X
- SET NURS(0)=0
- SET NURS(1)=NURSO
- DO X^NURCPP8
- SET NURSO=NURSO+1
- +3 QUIT
