- 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 Jan 18, 2025@03:21:50 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