NURCPP4 ;HIRMFO/JH/RM-NURSING CARE PLAN DATA OUTPUT part 4 ;4/29/93
;;4.0;NURSING SERVICE;;Apr 25, 1997
ILP1 ;
S NURSA(0)=$S($D(^TMP($J,"GMRGNAR",NURSRTK,NURSI(1),0)):^(0),1:""),NURSA=$P(NURSA(0),"^"),NURSA(1)=+$P(NURSA(0),"^",3)
F NURSK=1:1:$P(NURSA(0),"^",2) S ^TMP($J,"NURSDATA",NURSO)=" "_^TMP($J,"GMRGNAR",NURSRTK,NURSI(1),NURSK),NURSO=NURSO+1
F NURSI=0:0 S NURSI=$O(^TMP($J,"GMRGNAR",NURSI(1),NURSI)) Q:NURSI'>0 S NURSI(0)=NURSI(1) D INTER
S NURSA(0)=+$O(^GMR(124.3,GMRGPDA,1,"B",NURSA(1),0)) I $D(^GMR(124.3,GMRGPDA,1,NURSA(0),"ADD")),^("ADD")]"" S NURSADD=^("ADD"),NURSLGT=44-(NURSA*3) D FORMAT
S NURSO=NURSO+1,^TMP($J,"NURSDATA",NURSO)=""
Q
INTER ; CHECK FOR INTERVENTION DATE
S NURST(0)=1,^TMP($J,"NURSDATA",NURSO)=$E(NURSSS,1,NURSA*3+5)_"-"_$S($D(^TMP($J,"GMRGNAR",NURSI(0),NURSI,NURST(0))):^(NURST(0)),1:"")
F NURST(1)=0:0 S NURST(1)=$O(^TMP($J,"NURSDATE",NURSI,NURST(1))) Q:NURST(1)'>0 F NURST=0:0 S NURST=$O(^TMP($J,"NURSDATE",NURSI,NURST(1),NURST)) Q:NURST'>0 D INTER1
G INTER3
;
INTER1 ;
S X=$S($D(^TMP($J,"NURSDATE",NURSI,NURST(1),NURST)):^(NURST),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)_")"_$E(" ",1,2-$L($P(X,"^",4))),1:" "),NURSRN=$E($S($D(^VA(200,+$P(X,"^",3),0)):$P($P(^(0),"^"),","),1:"")_" ",1,10)
S X=^TMP($J,"NURSDATA",NURSO),^(NURSO)=X_$E(NURSSS,1,57-$L(X))_NURSH3_Y_NURSTAT_NURSRN S NURSO=NURSO+1,X=""
S:$S('$D(^TMP($J,"GMRGNAR",NURSI(0),NURSI,NURST(0)+1)):0,$E(^(NURST(0)+1))'=" ":1,1:0) NURST(0)=NURST(0)+1,X=$E(NURSSS,1,NURSA*3+6)_^(NURST(0)) S ^TMP($J,"NURSDATA",NURSO)=X Q
;
INTER3 I $D(^TMP($J,"NURSDATA",NURSO)),^(NURSO)'="" S NURSO=NURSO+1,^(NURSO)=""
F NURST=NURST(0):0 S NURST=$O(^TMP($J,"GMRGNAR",NURSI(0),NURSI,NURST)) Q:NURST'>0 S ^TMP($J,"NURSDATA",NURSO)=$E(NURSSS,1,NURSA*3+6)_^TMP($J,"GMRGNAR",NURSI(0),NURSI,NURST),NURSO=NURSO+1,^TMP($J,"NURSDATA",NURSO)=""
Q
FORMAT S NURSLGT(0)=$S(NURSLGT<44:2,1:(NURSLGT=44)),GMRGLEN=NURSLGT,GMRGPLN="Additional Text: "_$E(NURSADD,1,227)
I ^TMP($J,"NURSDATA",NURSO)'="" S NURSO=NURSO+1,^TMP($J,"NURSDATA",NURSO)=""
D FITLINE^GMRGRUT1 S ^TMP($J,"NURSDATA",NURSO)=" "_$S(NURSLGT(0)=1:" -",'NURSLGT(0):"",1:$E(NURSSS,1,NURSA*3+2)_"-")_GMRGPLN(0),NURSO=NURSO+1,^(NURSO)="" S GMRGLEN=NURSLGT,GMRGPLN=GMRGPLN(1)_$E(NURSADD,228,245) D FITLINE^GMRGRUT1
F NURSK=0:0 Q:GMRGPLN(0)="" S ^TMP($J,"NURSDATA",NURSO)=" "_$S(NURSLGT(0)=1:" ",'NURSLGT(0):"",1:$E(NURSSS,1,NURSA+1*3))_GMRGPLN(0),NURSO=NURSO+1,^(NURSO)="",GMRGPLN=GMRGPLN(1),GMRGLEN=NURSLGT D FITLINE^GMRGRUT1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCPP4 2595 printed Nov 22, 2024@17:30:44 Page 2
NURCPP4 ;HIRMFO/JH/RM-NURSING CARE PLAN DATA OUTPUT part 4 ;4/29/93
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
ILP1 ;
+1 SET NURSA(0)=$SELECT($DATA(^TMP($JOB,"GMRGNAR",NURSRTK,NURSI(1),0)):^(0),1:"")
SET NURSA=$PIECE(NURSA(0),"^")
SET NURSA(1)=+$PIECE(NURSA(0),"^",3)
+2 FOR NURSK=1:1:$PIECE(NURSA(0),"^",2)
SET ^TMP($JOB,"NURSDATA",NURSO)=" "_^TMP($JOB,"GMRGNAR",NURSRTK,NURSI(1),NURSK)
SET NURSO=NURSO+1
+3 FOR NURSI=0:0
SET NURSI=$ORDER(^TMP($JOB,"GMRGNAR",NURSI(1),NURSI))
if NURSI'>0
QUIT
SET NURSI(0)=NURSI(1)
DO INTER
+4 SET NURSA(0)=+$ORDER(^GMR(124.3,GMRGPDA,1,"B",NURSA(1),0))
IF $DATA(^GMR(124.3,GMRGPDA,1,NURSA(0),"ADD"))
IF ^("ADD")]""
SET NURSADD=^("ADD")
SET NURSLGT=44-(NURSA*3)
DO FORMAT
+5 SET NURSO=NURSO+1
SET ^TMP($JOB,"NURSDATA",NURSO)=""
+6 QUIT
INTER ; CHECK FOR INTERVENTION DATE
+1 SET NURST(0)=1
SET ^TMP($JOB,"NURSDATA",NURSO)=$EXTRACT(NURSSS,1,NURSA*3+5)_"-"_$SELECT($DATA(^TMP($JOB,"GMRGNAR",NURSI(0),NURSI,NURST(0))):^(NURST(0)),1:"")
+2 FOR NURST(1)=0:0
SET NURST(1)=$ORDER(^TMP($JOB,"NURSDATE",NURSI,NURST(1)))
if NURST(1)'>0
QUIT
FOR NURST=0:0
SET NURST=$ORDER(^TMP($JOB,"NURSDATE",NURSI,NURST(1),NURST))
if NURST'>0
QUIT
DO INTER1
+3 GOTO INTER3
+4 ;
INTER1 ;
+1 SET X=$SELECT($DATA(^TMP($JOB,"NURSDATE",NURSI,NURST(1),NURST)):^(NURST),1:"")
+2 SET Y=$PIECE(X,"^",2)
if Y'=""
SET Y=$EXTRACT(Y,4,5)_"/"_$EXTRACT(Y,6,7)_"/"_$EXTRACT(Y,2,3)
SET NURSTAT=$SELECT($LENGTH($PIECE(X,"^",4)):"("_$PIECE(X,"^",4)_")"_$EXTRACT(" ",1,2-$LENGTH($PIECE(X,"^",4))),1:" ")
SET NURSRN=$EXTRACT($SELECT($DATA(^VA(200,+$PIECE(X,"^",3),0)):$PIECE($PIECE(^(0),"^"),","),1:"")_" ",1,10)
+3 SET X=^TMP($JOB,"NURSDATA",NURSO)
SET ^(NURSO)=X_$EXTRACT(NURSSS,1,57-$LENGTH(X))_NURSH3_Y_NURSTAT_NURSRN
SET NURSO=NURSO+1
SET X=""
+4 if $SELECT('$DATA(^TMP($JOB,"GMRGNAR",NURSI(0),NURSI,NURST(0)+1))
SET NURST(0)=NURST(0)+1
SET X=$EXTRACT(NURSSS,1,NURSA*3+6)_^(NURST(0))
SET ^TMP($JOB,"NURSDATA",NURSO)=X
QUIT
+5 ;
INTER3 IF $DATA(^TMP($JOB,"NURSDATA",NURSO))
IF ^(NURSO)'=""
SET NURSO=NURSO+1
SET ^(NURSO)=""
+1 FOR NURST=NURST(0):0
SET NURST=$ORDER(^TMP($JOB,"GMRGNAR",NURSI(0),NURSI,NURST))
if NURST'>0
QUIT
SET ^TMP($JOB,"NURSDATA",NURSO)=$EXTRACT(NURSSS,1,NURSA*3+6)_^TMP($JOB,"GMRGNAR",NURSI(0),NURSI,NURST)
SET NURSO=NURSO+1
SET ^TMP($JOB,"NURSDATA",NURSO)=""
+2 QUIT
FORMAT SET NURSLGT(0)=$SELECT(NURSLGT<44:2,1:(NURSLGT=44))
SET GMRGLEN=NURSLGT
SET GMRGPLN="Additional Text: "_$EXTRACT(NURSADD,1,227)
+1 IF ^TMP($JOB,"NURSDATA",NURSO)'=""
SET NURSO=NURSO+1
SET ^TMP($JOB,"NURSDATA",NURSO)=""
+2 DO FITLINE^GMRGRUT1
SET ^TMP($JOB,"NURSDATA",NURSO)=" "_$SELECT(NURSLGT(0)=1:" -",'NURSLGT(0):"",1:$EXTRACT(NURSSS,1,NURSA*3+2)_"-")_GMRGPLN(0)
SET NURSO=NURSO+1
SET ^(NURSO)=""
SET GMRGLEN=NURSLGT
SET GMRGPLN=GMRGPLN(1)_$EXTRACT(NURSADD,228,245)
DO FITLINE^GMRGRUT1
+3 FOR NURSK=0:0
if GMRGPLN(0)=""
QUIT
SET ^TMP($JOB,"NURSDATA",NURSO)=" "_$SELECT(NURSLGT(0)=1:" ",'NURSLGT(0):"",1:$EXTRACT(NURSSS,1,NURSA+1*3))_GMRGPLN(0)
SET NURSO=NURSO+1
SET ^(NURSO)=""
SET GMRGPLN=GMRGPLN(1)
SET GMRGLEN=NURSLGT
DO FITLINE^GMRGRUT1
+4 QUIT
