NURCPP2 ;HIRMFO/JH/RM-NURSING CARE PLAN DATA OUTPUT part 2 ;4/29/93
;;4.0;NURSING SERVICE;;Apr 25, 1997
G:'$O(NURSB("G",""))!($G(NURSLVD)&(NURSPLN="C")) ARG
F NURSRTK=0:0 S NURSRTK=$O(NURSB("G",NURSRTK)) Q:NURSRTK'>0 D
. Q:'(NURSPLN="C"&$D(^GMR(124.3,GMRGPDA,1,"ALIST",NURSRTK))!(NURSPLN="A"&$D(^GMR(124.3,GMRGPDA,1,"B",NURSRTK))))
. S NURSB=$O(^GMR(124.3,GMRGPDA,1,"B",NURSRTK,0)) Q:NURSB'>0
. S GMRGXPRT=$S($P(NURSITHD,U,3)']"":$P($G(^GMRD(124.2,NURSRTK,0)),U,1),1:$P(NURSITHD,U,3))
. S GMRGXPRT(0)=$S($D(^GMR(124.3,GMRGPDA,1,NURSB,0)):$P(^(0),"^",2),1:""),GMRGXPRT(1)="^^0^^1" D EN1^GMRGRUT2 S GMRGPLN=GMRGXPRT,GMRGLEN=47 D FITLINE^GMRGRUT1
. F NURSE=0:0 Q:GMRGPLN(0)="" S ^TMP($J,"NURSDATA",NURSO)=" "_GMRGPLN(0),NURSO=NURSO+1,^(NURSO)="",GMRGPLN=GMRGPLN(1),GMRGLEN=47 D FITLINE^GMRGRUT1
. F NURSG(1)=0:0 S NURSG(1)=$O(^TMP($J,"GMRGNAR",NURSRTK,NURSG(1))) Q:NURSG(1)'>0 S NURSC=$S('$D(^GMRD(124.2,+NURSG(1),0)):"",$P(^(0),"^",4)=NURSGOCK:1,1:0) D GLP1:'NURSC I NURSC S NURSA=0,NURSG=NURSG(1),NURSG(0)=NURSRTK D GOAL
. I $D(^GMR(124.3,GMRGPDA,1,NURSB,"ADD")),^("ADD")]"" S NURSADD=^("ADD"),NURSLGT=44 D FORMAT^NURCPP4
. S NURSO=NURSO+1,^TMP($J,"NURSDATA",NURSO)=""
. Q
ARG G:'$O(NURSB("I",""))!($G(NURSLVD)&(NURSPLN="C")) ARI
F NURSRTK=0:0 S NURSRTK=$O(NURSB("I",NURSRTK)) Q:NURSRTK'>0 D
. Q:'(NURSPLN="C"&$D(^GMR(124.3,GMRGPDA,1,"ALIST",NURSRTK))!(NURSPLN="A"&$D(^GMR(124.3,GMRGPDA,1,"B",NURSRTK))))
. S NURSB=$O(^GMR(124.3,GMRGPDA,1,"B",NURSRTK,0)) Q:NURSB'>0
. S GMRGXPRT=$S($P(NURSITHD,U,4)']"":$P($G(^GMRD(124.2,NURSRTK,0)),U,1),1:$P(NURSITHD,U,4))
. S GMRGXPRT(0)=$S($D(^GMR(124.3,GMRGPDA,1,NURSB,0)):$P(^(0),"^",2),1:""),GMRGXPRT(1)="^^0^^1" D EN1^GMRGRUT2 S GMRGPLN=GMRGXPRT,GMRGLEN=47 D FITLINE^GMRGRUT1
. F NURSE=0:0 Q:GMRGPLN(0)="" S ^TMP($J,"NURSDATA",NURSO)=" "_GMRGPLN(0),NURSO=NURSO+1,^(NURSO)="",GMRGPLN=GMRGPLN(1),GMRGLEN=47 D FITLINE^GMRGRUT1
. F NURSI(1)=0:0 S NURSI(1)=$O(^TMP($J,"GMRGNAR",NURSRTK,NURSI(1))) Q:NURSI(1)'>0 D AL1
. I $D(^GMR(124.3,GMRGPDA,1,NURSB,"ADD")),^("ADD")]"" S NURSLGT=44,NURSADD=^("ADD") D FORMAT^NURCPP4
. Q
ARI Q
;
AL1 ;
S NURSC=$S('$D(^GMRD(124.2,+NURSI(1),0)):"",$P(^(0),"^",4)=NURSINCK:1,1:0) D ILP1^NURCPP4:'NURSC I NURSC S NURSA=0,NURSI=NURSI(1),NURSI(0)=NURSRTK D INTER^NURCPP4
Q
GLP1 ;
S NURSA(0)=$S($D(^TMP($J,"GMRGNAR",NURSRTK,NURSG(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,NURSG(1),NURSK),NURSO=NURSO+1
F NURSG=0:0 S NURSG=$O(^TMP($J,"GMRGNAR",NURSG(1),NURSG)) Q:NURSG'>0 S NURSG(0)=NURSG(1) D GOAL
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^NURCPP4
S NURSO=NURSO+1,^TMP($J,"NURSDATA",NURSO)=""
Q
GOAL ; CHECK FOR GOAL GOAL/EXPECTED OUTCOME TARGET DATE
S NURST(0)=1,^TMP($J,"NURSDATA",NURSO)=$E(NURSSS,1,NURSA*3+5)_"-"_$S($D(^TMP($J,"GMRGNAR",NURSG(0),NURSG,NURST(0))):^(NURST(0)),1:"")
F NURST(1)=0:0 S NURST(1)=$O(^TMP($J,"NURSDATE",NURSG,NURST(1))) Q:NURST(1)'>0 F NURST=0:0 S NURST=$O(^TMP($J,"NURSDATE",NURSG,NURST(1),NURST)) Q:NURST'>0 D GOAL1
I $D(^TMP($J,"NURSDATA",NURSO)),^(NURSO)'="" S NURSO=NURSO+1,^(NURSO)=""
F NURST=NURST(0):0 S NURST=$O(^TMP($J,"GMRGNAR",NURSG(0),NURSG,NURST)) Q:NURST'>0 S ^TMP($J,"NURSDATA",NURSO)=$E(NURSSS,1,NURSA*3+6)_^TMP($J,"GMRGNAR",NURSG(0),NURSG,NURST),NURSO=NURSO+1,^TMP($J,"NURSDATA",NURSO)=""
Q
;
GOAL1 ;
S X=$S($D(^TMP($J,"NURSDATE",NURSG,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:" ")
S 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,NURSO=NURSO+1,X=""
S:$S('$D(^TMP($J,"GMRGNAR",NURSG(0),NURSG,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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCPP2 4177 printed Nov 22, 2024@17:30:42 Page 2
NURCPP2 ;HIRMFO/JH/RM-NURSING CARE PLAN DATA OUTPUT part 2 ;4/29/93
+1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
+2 if '$ORDER(NURSB("G",""))!($GET(NURSLVD)&(NURSPLN="C"))
GOTO ARG
+3 FOR NURSRTK=0:0
SET NURSRTK=$ORDER(NURSB("G",NURSRTK))
if NURSRTK'>0
QUIT
Begin DoDot:1
+4 if '(NURSPLN="C"&$DATA(^GMR(124.3,GMRGPDA,1,"ALIST",NURSRTK))!(NURSPLN="A"&$DATA(^GMR(124.3,GMRGPDA,1,"B",NURSRTK))))
QUIT
+5 SET NURSB=$ORDER(^GMR(124.3,GMRGPDA,1,"B",NURSRTK,0))
if NURSB'>0
QUIT
+6 SET GMRGXPRT=$SELECT($PIECE(NURSITHD,U,3)']"":$PIECE($GET(^GMRD(124.2,NURSRTK,0)),U,1),1:$PIECE(NURSITHD,U,3))
+7 SET GMRGXPRT(0)=$SELECT($DATA(^GMR(124.3,GMRGPDA,1,NURSB,0)):$PIECE(^(0),"^",2),1:"")
SET GMRGXPRT(1)="^^0^^1"
DO EN1^GMRGRUT2
SET GMRGPLN=GMRGXPRT
SET GMRGLEN=47
DO FITLINE^GMRGRUT1
+8 FOR NURSE=0:0
if GMRGPLN(0)=""
QUIT
SET ^TMP($JOB,"NURSDATA",NURSO)=" "_GMRGPLN(0)
SET NURSO=NURSO+1
SET ^(NURSO)=""
SET GMRGPLN=GMRGPLN(1)
SET GMRGLEN=47
DO FITLINE^GMRGRUT1
+9 FOR NURSG(1)=0:0
SET NURSG(1)=$ORDER(^TMP($JOB,"GMRGNAR",NURSRTK,NURSG(1)))
if NURSG(1)'>0
QUIT
SET NURSC=$SELECT('$DATA(^GMRD(124.2,+NURSG(1),0)):"",$PIECE(^(0),"^",4)=NURSGOCK:1,1:0)
if 'NURSC
DO GLP1
IF NURSC
SET NURSA=0
SET NURSG=NURSG(1)
SET NURSG(0)=NURSRTK
DO GOAL
+10 IF $DATA(^GMR(124.3,GMRGPDA,1,NURSB,"ADD"))
IF ^("ADD")]""
SET NURSADD=^("ADD")
SET NURSLGT=44
DO FORMAT^NURCPP4
+11 SET NURSO=NURSO+1
SET ^TMP($JOB,"NURSDATA",NURSO)=""
+12 QUIT
End DoDot:1
ARG if '$ORDER(NURSB("I",""))!($GET(NURSLVD)&(NURSPLN="C"))
GOTO ARI
+1 FOR NURSRTK=0:0
SET NURSRTK=$ORDER(NURSB("I",NURSRTK))
if NURSRTK'>0
QUIT
Begin DoDot:1
+2 if '(NURSPLN="C"&$DATA(^GMR(124.3,GMRGPDA,1,"ALIST",NURSRTK))!(NURSPLN="A"&$DATA(^GMR(124.3,GMRGPDA,1,"B",NURSRTK))))
QUIT
+3 SET NURSB=$ORDER(^GMR(124.3,GMRGPDA,1,"B",NURSRTK,0))
if NURSB'>0
QUIT
+4 SET GMRGXPRT=$SELECT($PIECE(NURSITHD,U,4)']"":$PIECE($GET(^GMRD(124.2,NURSRTK,0)),U,1),1:$PIECE(NURSITHD,U,4))
+5 SET GMRGXPRT(0)=$SELECT($DATA(^GMR(124.3,GMRGPDA,1,NURSB,0)):$PIECE(^(0),"^",2),1:"")
SET GMRGXPRT(1)="^^0^^1"
DO EN1^GMRGRUT2
SET GMRGPLN=GMRGXPRT
SET GMRGLEN=47
DO FITLINE^GMRGRUT1
+6 FOR NURSE=0:0
if GMRGPLN(0)=""
QUIT
SET ^TMP($JOB,"NURSDATA",NURSO)=" "_GMRGPLN(0)
SET NURSO=NURSO+1
SET ^(NURSO)=""
SET GMRGPLN=GMRGPLN(1)
SET GMRGLEN=47
DO FITLINE^GMRGRUT1
+7 FOR NURSI(1)=0:0
SET NURSI(1)=$ORDER(^TMP($JOB,"GMRGNAR",NURSRTK,NURSI(1)))
if NURSI(1)'>0
QUIT
DO AL1
+8 IF $DATA(^GMR(124.3,GMRGPDA,1,NURSB,"ADD"))
IF ^("ADD")]""
SET NURSLGT=44
SET NURSADD=^("ADD")
DO FORMAT^NURCPP4
+9 QUIT
End DoDot:1
ARI QUIT
+1 ;
AL1 ;
+1 SET NURSC=$SELECT('$DATA(^GMRD(124.2,+NURSI(1),0)):"",$PIECE(^(0),"^",4)=NURSINCK:1,1:0)
if 'NURSC
DO ILP1^NURCPP4
IF NURSC
SET NURSA=0
SET NURSI=NURSI(1)
SET NURSI(0)=NURSRTK
DO INTER^NURCPP4
+2 QUIT
GLP1 ;
+1 SET NURSA(0)=$SELECT($DATA(^TMP($JOB,"GMRGNAR",NURSRTK,NURSG(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,NURSG(1),NURSK)
SET NURSO=NURSO+1
+3 FOR NURSG=0:0
SET NURSG=$ORDER(^TMP($JOB,"GMRGNAR",NURSG(1),NURSG))
if NURSG'>0
QUIT
SET NURSG(0)=NURSG(1)
DO GOAL
+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^NURCPP4
+5 SET NURSO=NURSO+1
SET ^TMP($JOB,"NURSDATA",NURSO)=""
+6 QUIT
GOAL ; CHECK FOR GOAL GOAL/EXPECTED OUTCOME TARGET DATE
+1 SET NURST(0)=1
SET ^TMP($JOB,"NURSDATA",NURSO)=$EXTRACT(NURSSS,1,NURSA*3+5)_"-"_$SELECT($DATA(^TMP($JOB,"GMRGNAR",NURSG(0),NURSG,NURST(0))):^(NURST(0)),1:"")
+2 FOR NURST(1)=0:0
SET NURST(1)=$ORDER(^TMP($JOB,"NURSDATE",NURSG,NURST(1)))
if NURST(1)'>0
QUIT
FOR NURST=0:0
SET NURST=$ORDER(^TMP($JOB,"NURSDATE",NURSG,NURST(1),NURST))
if NURST'>0
QUIT
DO GOAL1
+3 IF $DATA(^TMP($JOB,"NURSDATA",NURSO))
IF ^(NURSO)'=""
SET NURSO=NURSO+1
SET ^(NURSO)=""
+4 FOR NURST=NURST(0):0
SET NURST=$ORDER(^TMP($JOB,"GMRGNAR",NURSG(0),NURSG,NURST))
if NURST'>0
QUIT
SET ^TMP($JOB,"NURSDATA",NURSO)=$EXTRACT(NURSSS,1,NURSA*3+6)_^TMP($JOB,"GMRGNAR",NURSG(0),NURSG,NURST)
SET NURSO=NURSO+1
SET ^TMP($JOB,"NURSDATA",NURSO)=""
+5 QUIT
+6 ;
GOAL1 ;
+1 SET X=$SELECT($DATA(^TMP($JOB,"NURSDATE",NURSG,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:" ")
+3 SET NURSRN=$EXTRACT($SELECT($DATA(^VA(200,+$PIECE(X,"^",3),0)):$PIECE($PIECE(^(0),"^"),","),1:"")_" ",1,10)
+4 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=""
+5 if $SELECT('$DATA(^TMP($JOB,"GMRGNAR",NURSG(0),NURSG,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
+6 QUIT