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.
Q
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 Sep 23, 2025@19:57:11 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
