Routine: NURCPPS3

NURCPPS3 ;HIRMFO/JH,RM-NURSING CARE PLAN DATABASE SEARCH part 3 ;8/29/96

 ;;4.0;NURSING SERVICE;;Apr 25, 1997

CONT S NURSPNAM=$E(GMRGVNAM,1,20),NURSSSN=GMRGVSSN,NURAGE=GMRGVAGE

 S DIC="^DPT(",DR=".05;.08",DA=DFN,DIQ="NURSPAT(",DIQ(0)="I" D EN^DIQ1

 S NURSMAR=$P($G(^DIC(11,+$G(NURSPAT(2,DFN,.05,"I")),0)),"^",3),NURSMAR=$E(NURSMAR_" ")

 S NURSREL=$P($G(^DIC(13,+$G(NURSPAT(2,DFN,.08,"I")),0)),"^"),NURSREL=$E(NURSREL_"    ",1,4)

 S NURSWD=$E(GMRGVWRD,1,8)_$E("        ",$L(GMRGVWRD)+1,8),NURSRB=$E(GMRGVRBD,1,10)_$E("          ",$L(GMRGVRBD)+1,10),NURSPROV=$E(GMRGVPRV,1,20),NURSDIAG=GMRGVDX

 W !!,"This Report may be Queued to print on another device,",!,"freeing your terminal for other use.",!

 S GMRGPDT="N" F X="GMRGOUT","NURSPRT","NURSSSN","GMRGPDA","GMRGPDT","GMRGPAR","DFN","NURSPNAM","NURSPLN","NURSREL","NURAGE","NURSRB","NURSWD","NURSMAR","NURSPROV","NURSDIAG" S ZTSAVE(X)=""

 S ZTDESC="Patient Care Plan Print",ZTRTN="LATER^NURCPPS3" D EN7^NURSUT0 Q:POP!($D(ZTSK))

 U IO D:'$D(IO("Q")) WAIT^DICD

LATER F X="NURSDATA","NURSAUD","NURSEVAL","NURSOT","GMRGNAR","NURSGO","NURSIN","NURSTARG","NURSORD" K ^TMP($J,X)

 K NURSAL D ALLERGY^NURCUT1(DFN,.NURSAL)

 S NURSJ=1,X=1,NURSALGR(1)="Reactions: " F NURSI=0:0 S NURSI=$O(NURSAL(NURSI)) Q:NURSI'>0  D

 .   I $L(NURSALGR(X))+$L(NURSAL(NURSI))+2>IOM S NURSJ=1,NURSALGR(X)=NURSALGR(X)_",",X=X+1,NURSALGR(X)="           " ; start next line

 .   S NURSALGR(X)=NURSALGR(X)_$S(NURSJ>1:", ",1:"")_$P(NURSAL(NURSI),U),NURSJ=NURSJ+1 ; add this allergy to end of line

 .   Q

 K NURSAL,NURCLEG I NURSPLN="A" D

 .   S NURCLEG(1)="   E-prob eval dt      U-prob unresolved at discharge    S-prob suspended",NURCLEG(2)="   T-goal target dt    DC-order/goal discontinued        M-goal met"

 .   S NURCLEG(3)="   @-entered in error  R-prob resolved/order reinstated",X=X+3

 .   Q

 I NURSPLN="C" S NURCLEG(1)="   E-prob eval dt      U-prob unresolved at discharge    S-prob suspended",NURCLEG(2)="   T-goal target dt    R-prob resolved/order reinstated",X=X+2

 S NURSIOSL=IOSL-5-X-$S($E(IOST)="C":2,1:0)

 I GMRGPDT]"" S X=GMRGPDT,%DT="TS" D ^%DT Q:Y'>0  S GMRGPDT=Y

 S NURSOUT=0,NURSPOI=0 I GMRGPDA>0 S NURSPOI=$O(^NURSC(216.8,"B",GMRGPDA,0)) Q:NURSPOI'>0

 S NURSRM=$S(IOM'<132:104,1:30+(IOM-80))

 S NURSSS="",$P(NURSSS," ",132)=""

 S NURSITHD=$G(^DIC(213.9,1,"CPH")) ; get site configured report params.

 S NURSTITL=$S($P(NURSITHD,U)]"":$P(NURSITHD,U),1:"PATIENT PLAN OF CARE - Patient Print")

 F NURSP=0:0 S NURSP=$O(^NURSC(216.8,NURSPOI,"PROB",NURSP)) Q:NURSP'>0  S NURSPRB=+^(NURSP,0) I $S(NURSPLN="A"&$O(^GMR(124.3,GMRGPDA,1,"B",NURSPRB,0)):1,NURSPLN="C"&$O(^GMR(124.3,GMRGPDA,1,"ALIST",NURSPRB,0)):1,1:0) D STOR

 S NURSGCK=+$O(^GMRD(124.25,"AA","NURSC","GOALS/EXPECTED OUTCOMES",0)),NURSICK=+$O(^GMRD(124.25,"AA","NURSC","NURSING INTERVENTION",0)),NURSGOCK=+$O(^GMRD(124.25,"AA","NURSC","GOAL",0)),NURSINCK=+$O(^GMRD(124.25,"AA","NURSC","ORDERABLE",0))

 S NURSP(0)="" F NURSX=0:0 S NURSP(0)=$O(NURSPRB(NURSP(0))) Q:NURSP(0)=""  F NURSP=0:0 S NURSP=$O(NURSPRB(NURSP(0),NURSP)) Q:NURSP'>0  D PROB^NURCPPS2

 S NURSERR=$G(^GMR(124.3,GMRGPDA,5)) I +NURSERR S Y=$P(NURSERR,"^",2) D D^DIQ S NURSERR(1)="",NURSERR(2)="** ENTERED IN ERROR BY: "_$E($P($G(^VA(200,+$P(NURSERR,"^",3),0)),"^"),1,20)_" ON: "_Y_" **",$P(NURSERR(1),"*",$L(NURSERR(2))+1)=""

 U IO D EN1^NURCPP5:IOM'<132,EN1^NURCPP1:IOM<132 I $E(IOST)="C" W:ANS'["^" !,$C(7),"Press any key to continue. " R:ANS'["^" X:DTIME S:'$T!(X="^")!(X="^^") NURSOUT=1 ;Call Data Processing Output Routines, then quit.

STOR S NURSK=$S($D(^GMRD(124.2,+NURSPRB,0)):$P(^(0),"^"),1:"") Q:NURSK=""  S NURSPRB(NURSK,NURSPRB)=$O(^GMR(124.3,GMRGPDA,1,"B",NURSPRB,0)) Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCPPS3   3683     printed  Apr 23, 2025@18:35:19                                                                                                                                                                                                    Page 2

NURCPPS3  ;HIRMFO/JH,RM-NURSING CARE PLAN DATABASE SEARCH part 3 ;8/29/96

 +1       ;;4.0;NURSING SERVICE;;Apr 25, 1997

CONT       SET NURSPNAM=$EXTRACT(GMRGVNAM,1,20)

           SET NURSSSN=GMRGVSSN

           SET NURAGE=GMRGVAGE

 +1        SET DIC="^DPT("

           SET DR=".05;.08"

           SET DA=DFN

           SET DIQ="NURSPAT("

           SET DIQ(0)="I"

           DO EN^DIQ1

 +2        SET NURSMAR=$PIECE($GET(^DIC(11,+$GET(NURSPAT(2,DFN,.05,"I")),0)),"^",3)

           SET NURSMAR=$EXTRACT(NURSMAR_" ")

 +3        SET NURSREL=$PIECE($GET(^DIC(13,+$GET(NURSPAT(2,DFN,.08,"I")),0)),"^")

           SET NURSREL=$EXTRACT(NURSREL_"    ",1,4)

 +4        SET NURSWD=$EXTRACT(GMRGVWRD,1,8)_$EXTRACT("        ",$LENGTH(GMRGVWRD)+1,8)

           SET NURSRB=$EXTRACT(GMRGVRBD,1,10)_$EXTRACT("          ",$LENGTH(GMRGVRBD)+1,10)

           SET NURSPROV=$EXTRACT(GMRGVPRV,1,20)

           SET NURSDIAG=GMRGVDX

 +5        WRITE !!,"This Report may be Queued to print on another device,",!,"freeing your terminal for other use.",!

 +6        SET GMRGPDT="N"

           FOR X="GMRGOUT","NURSPRT","NURSSSN","GMRGPDA","GMRGPDT","GMRGPAR","DFN","NURSPNAM","NURSPLN","NURSREL","NURAGE","NURSRB","NURSWD","NURSMAR","NURSPROV","NURSDIAG"

               SET ZTSAVE(X)=""

 +7        SET ZTDESC="Patient Care Plan Print"

           SET ZTRTN="LATER^NURCPPS3"

           DO EN7^NURSUT0

           if POP!($DATA(ZTSK))

               QUIT

 +8        USE IO

           if '$DATA(IO("Q"))

               DO WAIT^DICD

LATER      FOR X="NURSDATA","NURSAUD","NURSEVAL","NURSOT","GMRGNAR","NURSGO","NURSIN","NURSTARG","NURSORD"

               KILL ^TMP($JOB,X)

 +1        KILL NURSAL

           DO ALLERGY^NURCUT1(DFN,.NURSAL)

 +2        SET NURSJ=1

           SET X=1

           SET NURSALGR(1)="Reactions: "

           FOR NURSI=0:0

               SET NURSI=$ORDER(NURSAL(NURSI))

               if NURSI'>0

                   QUIT

               Begin DoDot:1

 +3       ; start next line

                   IF $LENGTH(NURSALGR(X))+$LENGTH(NURSAL(NURSI))+2>IOM

                       SET NURSJ=1

                       SET NURSALGR(X)=NURSALGR(X)_","

                       SET X=X+1

                       SET NURSALGR(X)="           "

 +4       ; add this allergy to end of line

                   SET NURSALGR(X)=NURSALGR(X)_$SELECT(NURSJ>1:", ",1:"")_$PIECE(NURSAL(NURSI),U)

                   SET NURSJ=NURSJ+1

 +5                QUIT

               End DoDot:1

 +6        KILL NURSAL,NURCLEG

           IF NURSPLN="A"

               Begin DoDot:1

 +7                SET NURCLEG(1)="   E-prob eval dt      U-prob unresolved at discharge    S-prob suspended"

                   SET NURCLEG(2)="   T-goal target dt    DC-order/goal discontinued        M-goal met"

 +8                SET NURCLEG(3)="   @-entered in error  R-prob resolved/order reinstated"

                   SET X=X+3

 +9                QUIT

               End DoDot:1

 +10       IF NURSPLN="C"

               SET NURCLEG(1)="   E-prob eval dt      U-prob unresolved at discharge    S-prob suspended"

               SET NURCLEG(2)="   T-goal target dt    R-prob resolved/order reinstated"

               SET X=X+2

 +11       SET NURSIOSL=IOSL-5-X-$SELECT($EXTRACT(IOST)="C":2,1:0)

 +12       IF GMRGPDT]""

               SET X=GMRGPDT

               SET %DT="TS"

               DO ^%DT

               if Y'>0

                   QUIT

               SET GMRGPDT=Y

 +13       SET NURSOUT=0

           SET NURSPOI=0

           IF GMRGPDA>0

               SET NURSPOI=$ORDER(^NURSC(216.8,"B",GMRGPDA,0))

               if NURSPOI'>0

                   QUIT

 +14       SET NURSRM=$SELECT(IOM'<132:104,1:30+(IOM-80))

 +15       SET NURSSS=""

           SET $PIECE(NURSSS," ",132)=""

 +16      ; get site configured report params.

           SET NURSITHD=$GET(^DIC(213.9,1,"CPH"))

 +17       SET NURSTITL=$SELECT($PIECE(NURSITHD,U)]"":$PIECE(NURSITHD,U),1:"PATIENT PLAN OF CARE - Patient Print")

 +18       FOR NURSP=0:0

               SET NURSP=$ORDER(^NURSC(216.8,NURSPOI,"PROB",NURSP))

               if NURSP'>0

                   QUIT

               SET NURSPRB=+^(NURSP,0)

               IF $SELECT(NURSPLN="A"&$ORDER(^GMR(124.3,GMRGPDA,1,"B",NURSPRB,0)):1,NURSPLN="C"&$ORDER(^GMR(124.3,GMRGPDA,1,"ALIST",NURSPRB,0)):1,1:0)

                   DO STOR

 +19      ;

 +20       SET NURSGCK=+$ORDER(^GMRD(124.25,"AA","NURSC","GOALS/EXPECTED OUTCOMES",0))

           SET NURSICK=+$ORDER(^GMRD(124.25,"AA","NURSC","NURSING INTERVENTION",0))

           SET NURSGOCK=+$ORDER(^GMRD(124.25,"AA","NURSC","GOAL",0))

           SET NURSINCK=+$ORDER(^GMRD(124.25,"AA","NURSC","ORDERABLE",0))

 +21       SET NURSP(0)=""

           FOR NURSX=0:0

               SET NURSP(0)=$ORDER(NURSPRB(NURSP(0)))

               if NURSP(0)=""

                   QUIT

               FOR NURSP=0:0

                   SET NURSP=$ORDER(NURSPRB(NURSP(0),NURSP))

                   if NURSP'>0

                       QUIT

                   DO PROB^NURCPPS2

 +22       SET NURSERR=$GET(^GMR(124.3,GMRGPDA,5))

           IF +NURSERR

               SET Y=$PIECE(NURSERR,"^",2)

               DO D^DIQ

               SET NURSERR(1)=""

               SET NURSERR(2)="** ENTERED IN ERROR BY: "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE(NURSERR,"^",3),0)),"^"),1,20)_" ON: "_Y_" **"

               SET $PIECE(NURSERR(1),"*",$LENGTH(NURSERR(2))+1)=""

 +23      ;Call Data Processing Output Routines, then quit.

           USE IO

           if IOM'<132

               DO EN1^NURCPP5

           if IOM<132

               DO EN1^NURCPP1

           IF $EXTRACT(IOST)="C"

               if ANS'["^"

                   WRITE !,$CHAR(7),"Press any key to continue. "

               if ANS'["^"

                   READ X:DTIME

               if '$TEST!(X="^")!(X="^^")

                   SET NURSOUT=1

 +24       QUIT

STOR       SET NURSK=$SELECT($DATA(^GMRD(124.2,+NURSPRB,0)):$PIECE(^(0),"^"),1:"")

           if NURSK=""

               QUIT

           SET NURSPRB(NURSK,NURSPRB)=$ORDER(^GMR(124.3,GMRGPDA,1,"B",NURSPRB,0))

           QUIT

NURCPPS3.m