NURCPP7 ;HIRMFO/JH/RM-NURSING CARE PLAN DATA OUTPUT Part 3 ;4/29/93
;;4.0;NURSING SERVICE;;Apr 25, 1997
; This is the Patient Problem Listing,Data Processor,Output Routine
; 132 Col. Compressed print
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 NURS=$E(^TMP($J,"GMRGNAR",NURSRTK,NURSI(1),NURSK)_NURSSS,1,29)_"||",NURS(0)=2,NURS(1)=NURSO2 D X^NURCPP8 S NURSO2=NURSO2+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=0,NURSO4=NURSO2,NURSRET=3 D FORMAT S NURSO2=NURSO4
S NURSO2=NURSO2+1,NURS="||",NURS(0)=2,NURS(1)=NURSO2 D X^NURCPP8
Q
INTER ; CHECK FOR INTERVENTION DATE
S NURST=0,NURSJ=1
S NURS=$S($D(^TMP($J,"GMRGNAR",NURSI(0),NURSI,NURSJ)):$E(NURSSS,1,NURSA*3)_^(NURSJ),1:"")
F NURST(0)=0:0 S NURST(0)=$O(^TMP($J,"NURSDATE",NURSI,NURST(0))) Q:NURST(0)'>0 F NURST=0:0 S NURST=$O(^TMP($J,"NURSDATE",NURSI,NURST(0),NURST)) Q:NURST'>0 D INTER1
F NURST=NURSJ:0 Q:NURS="" S NURS(0)=2,NURS(1)=NURSO2 D X^NURCPP8 S NURSO2=NURSO2+1 S NURST=$O(^TMP($J,"GMRGNAR",NURSI(0),NURSI,NURST)) Q:NURST="" S NURS=$E(NURSSS,1,NURSA*3+1)_^TMP($J,"GMRGNAR",NURSI(0),NURSI,NURST)_"||"
Q
;
INTER1 ;
S X=$S($D(^TMP($J,"NURSDATE",NURSI,NURST(0),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)):$E($P($P(^(0),"^"),",",2))_$E($P($P(^(0),"^"),",")),1:"")_" ",1,2)
S NURS=NURS_"|"_Y_NURSTAT_NURSRN,NURS(0)=2,NURS(1)=NURSO2 D X^NURCPP8 S NURSO2=NURSO2+1
I $D(^TMP($J,"GMRGNAR",NURSI(0),NURSI,NURSJ+1)),$P(^(NURSJ+1),"^")'="" S NURSJ=NURSJ+1,NURS=$E(NURSSS,1,NURSA*3+1)_^TMP($J,"GMRGNAR",NURSI(0),NURSI,NURSJ)
E S NURS=""
Q
FORMAT ;
S NURS=$S(NURSLGT:"",1:$E(NURSSS,1,NURSA*3))_"-Additional Text:||",NURS(0)=$S(NURSRET=2:1,NURSRET=3:2,1:0),NURS(1)=NURSO4 D X^NURCPP8
S NURSLGT(0)=28-$S(NURSLGT:0,1:(NURSA*3)),GMRGLEN=NURSLGT(0),GMRGPLN=$E(NURSADD,1,227),NURSO4=NURSO4+1
D FITLINE^GMRGRUT1 S NURS=$E(NURSSS,1,$S(NURSLGT:1,1:NURSA*3+1))_GMRGPLN(0)_"||",NURS(0)=$S(NURSRET=2:1,NURSRET=3:2,1:0),NURS(1)=NURSO4 D X^NURCPP8
S NURSO4=NURSO4+1,GMRGLEN=NURSLGT(0),GMRGPLN=GMRGPLN(1)_$E(NURSADD,228,245) D FITLINE^GMRGRUT1
F NURSK=0:0 Q:GMRGPLN(0)="" S NURS=$E(NURSSS,1,$S(NURSLGT:1,1:NURSA*3+1))_GMRGPLN(0)_"||",NURS(0)=$S(NURSRET=2:1,NURSRET=3:2,1:0),NURS(1)=NURSO4 D X^NURCPP8 S NURSO4=NURSO4+1,GMRGPLN=GMRGPLN(1),GMRGLEN=NURSLGT(0) D FITLINE^GMRGRUT1
Q
NURCPP7 ;HIRMFO/JH/RM-NURSING CARE PLAN DATA OUTPUT Part 3 ;4/29/93
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
+2 ; This is the Patient Problem Listing,Data Processor,Output Routine
+3 ; 132 Col. Compressed print
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 NURS=$EXTRACT(^TMP($JOB,"GMRGNAR",NURSRTK,NURSI(1),NURSK)_NURSSS,1,29)_"||"
SET NURS(0)=2
SET NURS(1)=NURSO2
DO X^NURCPP8
SET NURSO2=NURSO2+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=0
SET NURSO4=NURSO2
SET NURSRET=3
DO FORMAT
SET NURSO2=NURSO4
+5 SET NURSO2=NURSO2+1
SET NURS="||"
SET NURS(0)=2
SET NURS(1)=NURSO2
DO X^NURCPP8
+6 QUIT
INTER ; CHECK FOR INTERVENTION DATE
+1 SET NURST=0
SET NURSJ=1
+2 SET NURS=$SELECT($DATA(^TMP($JOB,"GMRGNAR",NURSI(0),NURSI,NURSJ)):$EXTRACT(NURSSS,1,NURSA*3)_^(NURSJ),1:"")
+3 FOR NURST(0)=0:0
SET NURST(0)=$ORDER(^TMP($JOB,"NURSDATE",NURSI,NURST(0)))
IF NURST(0)'>0
QUIT
FOR NURST=0:0
SET NURST=$ORDER(^TMP($JOB,"NURSDATE",NURSI,NURST(0),NURST))
IF NURST'>0
QUIT
DO INTER1
+4 FOR NURST=NURSJ:0
IF NURS=""
QUIT
SET NURS(0)=2
SET NURS(1)=NURSO2
DO X^NURCPP8
SET NURSO2=NURSO2+1
SET NURST=$ORDER(^TMP($JOB,"GMRGNAR",NURSI(0),NURSI,NURST))
IF NURST=""
QUIT
SET NURS=$EXTRACT(NURSSS,1,NURSA*3+1)_^TMP($JOB,"GMRGNAR",NURSI(0),NURSI,NURST)_"||"
+5 QUIT
+6 ;
INTER1 ;
+1 SET X=$SELECT($DATA(^TMP($JOB,"NURSDATE",NURSI,NURST(0),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)
+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)):$EXTRACT($PIECE($PIECE(^(0),"^"),",",2))_$EXTRACT($PIECE($PIECE(^(0),"^"),",")),1:"")_" ",1,2)
+4 SET NURS=NURS_"|"_Y_NURSTAT_NURSRN
SET NURS(0)=2
SET NURS(1)=NURSO2
DO X^NURCPP8
SET NURSO2=NURSO2+1
+5 IF $DATA(^TMP($JOB,"GMRGNAR",NURSI(0),NURSI,NURSJ+1))
IF $PIECE(^(NURSJ+1),"^")'=""
SET NURSJ=NURSJ+1
SET NURS=$EXTRACT(NURSSS,1,NURSA*3+1)_^TMP($JOB,"GMRGNAR",NURSI(0),NURSI,NURSJ)
+6 IF '$TEST
SET NURS=""
+7 QUIT
FORMAT ;
+1 SET NURS=$SELECT(NURSLGT:"",1:$EXTRACT(NURSSS,1,NURSA*3))_"-Additional Text:||"
SET NURS(0)=$SELECT(NURSRET=2:1,NURSRET=3:2,1:0)
SET NURS(1)=NURSO4
DO X^NURCPP8
+2 SET NURSLGT(0)=28-$SELECT(NURSLGT:0,1:(NURSA*3))
SET GMRGLEN=NURSLGT(0)
SET GMRGPLN=$EXTRACT(NURSADD,1,227)
SET NURSO4=NURSO4+1
+3 DO FITLINE^GMRGRUT1
SET NURS=$EXTRACT(NURSSS,1,$SELECT(NURSLGT:1,1:NURSA*3+1))_GMRGPLN(0)_"||"
SET NURS(0)=$SELECT(NURSRET=2:1,NURSRET=3:2,1:0)
SET NURS(1)=NURSO4
DO X^NURCPP8
+4 SET NURSO4=NURSO4+1
SET GMRGLEN=NURSLGT(0)
SET GMRGPLN=GMRGPLN(1)_$EXTRACT(NURSADD,228,245)
DO FITLINE^GMRGRUT1
+5 FOR NURSK=0:0
IF GMRGPLN(0)=""
QUIT
SET NURS=$EXTRACT(NURSSS,1,$SELECT(NURSLGT:1,1:NURSA*3+1))_GMRGPLN(0)_"||"
SET NURS(0)=$SELECT(NURSRET=2:1,NURSRET=3:2,1:0)
SET NURS(1)=NURSO4
DO X^NURCPP8
SET NURSO4=NURSO4+1
SET GMRGPLN=GMRGPLN(1)
SET GMRGLEN=NURSLGT(0)
DO FITLINE^GMRGRUT1
+6 QUIT
