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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCPP9 2643 printed Nov 22, 2024@17:30:48 Page 2
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
