Routine: NURCPP7

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

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)_"||"

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=""

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

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCPP7   2751     printed  Feb 18, 2025@23:47:08                                                                                                                                                                                                     Page 2

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

NURCPP7.m