- NURCAS1 ;HIRMFO/MD/RM/MD-PATIENT PROBLEM/NURSING INTERVENTION PRINT ;10/2/95
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- S GMRGRT=$O(^GMRD(124.2,"AA","NURSC",2,"Nursing Care Plan",1,0)),GMRGPDA=0
- F REVDAT=0:0 S REVDAT=$O(^GMR(124.3,"AA",DFN,GMRGRT,REVDAT)) Q:'REVDAT S GMRGPDA=$O(^GMR(124.3,"AA",DFN,GMRGRT,REVDAT,0)) I GMRGPDA Q:'$S('$D(^GMR(124.3,GMRGPDA,5)):0,1:+^(5)) S GMRGPDA=0
- Q:'GMRGPDA S NURSCPE=+$O(^NURSC(216.8,"B",GMRGPDA,0))
- K NURSPROB,NURSORD,^TMP($J,"GMRGNAR"),^TMP($J,"NURPROB")
- F PROB=0:0 S PROB=$O(^NURSC(216.8,NURSCPE,"EVAL","AA",PROB)) Q:PROB'>0 S REVDATE=+$O(^(PROB,0)),DA=+$O(^(REVDATE,0)) I $D(^NURSC(216.8,NURSCPE,"EVAL",DA,0)),'$P(^(0),"^",4) D PROB
- D NOW^%DTC S GMRGPDT=% F INTER=0:0 S INTER=$O(^NURSC(216.8,NURSCPE,"ORD","AA",INTER)) Q:INTER'>0 S REVDATE=+$O(^(INTER,0)),DA=+$O(^(REVDATE,0)) I $D(^NURSC(216.8,NURSCPE,"ORD",DA,0)),'$P(^(0),"^",3) D INTER
- S (ISW,PSW)=0,(ISW(0),PSW(0))=1,(INTER,PROB)="" D AR F NX=1:1 S INTER=$S(NX=1!(NX'=1&(INTER'="")&'ISW):$O(NURSORD(INTER)),1:INTER),PROB=$S(NX=1!(NX'=1&(PROB'="")&'PSW):$O(NURSPROB(PROB)),1:PROB) Q:INTER=""&(PROB="") D FORMAT Q:NURQUIT
- K ^TMP($J,"GMRGNAR"),^TMP($J,"NURPROB")
- Q
- PROB ;PATIENT PROBLEM ARRAY
- S NURPROB=$P($G(^GMRD(124.2,PROB,0)),"^") Q:'$L(NURPROB)!'$D(^GMR(124.3,GMRGPDA,1,"ALIST",PROB))
- S P=+$O(^GMR(124.3,GMRGPDA,1,"B",PROB,0)),GMRGXPRT=NURPROB,GMRGXPRT(0)=$S($D(^GMR(124.3,GMRGPDA,1,P,0)):$P(^(0),"^",2),1:""),GMRGXPRT(1)="^^0^^1" D EN1^GMRGRUT2 S PRPROB=GMRGXPRT K GMRGXPRT
- S NURSPROB(PRPROB)=PROB
- F NX=1:1 S GMRGLEN=$S(NX=1:38,1:36),GMRGPLN=PRPROB D FITLINE^GMRGRUT1 S ^TMP($J,"NURPROB",PROB,NX)=GMRGPLN(0),PRPROB=GMRGPLN(1) Q:PRPROB=""
- Q
- INTER ;NURSING INTERVENTION ARRAY
- S NURORD=$P($G(^GMRD(124.2,INTER,0)),"^") Q:'$L(NURORD)!'$D(^GMR(124.3,GMRGPDA,1,"ALIST",INTER))
- S P=+$O(^GMR(124.3,GMRGPDA,1,"B",INTER,0)),GMRGXPRT=NURORD,GMRGXPRT(0)=$S($D(^GMR(124.3,GMRGPDA,1,P,0)):$P(^(0),"^",2),1:""),GMRGXPRT(1)="^^0^^1" D EN1^GMRGRUT2 S NURORD=GMRGXPRT K GMRGXPRT
- S NURSORD(NURORD)=INTER
- S GMRGPAR=INTER,GMRGPAR(0)="0^"_(IOM-34)_"^2^NURORD" D EN1^GMRGPNBL
- Q
- FORMAT ;PATIENT PROBLEM/NURSING INTERVENTION DISPLAY
- D:PROB'=""
- . F RVDT=0:0 S RVDT=$O(^NURSC(216.8,NURSCPE,"EVAL","AA",NURSPROB(PROB),RVDT)) Q:RVDT'>0 S IEN=$O(^NURSC(216.8,NURSCPE,"EVAL","AA",NURSPROB(PROB),RVDT,0)) I IEN>0 D Q
- . . S XX=$G(^NURSC(216.8,NURSCPE,"EVAL",IEN,0)),Y=$P(XX,U,5) D DD^%DT S NURSEVDT=Y
- . . Q
- . Q
- I PROB'="",'PSW S PRPROB=$G(^TMP($J,"NURPROB",+NURSPROB(PROB),2)),NURPLN=$G(^TMP($J,"NURPROB",+NURSPROB(PROB),1))_"^"_NURSEVDT,(PSW(0),PSW,PSW(1))=1
- E I PROB'="" S PSW(1)=PSW(1)+1,PRPROB=$G(^TMP($J,"NURPROB",+NURSPROB(PROB),PSW(1)+1)),NURPLN=$G(^TMP($J,"NURPROB",+NURSPROB(PROB),PSW(1)))_"^"_NURSEVDT
- I INTER'="",'ISW S PRORD=$G(^TMP($J,"GMRGNAR","NURORD",+NURSORD(INTER),2)),NURPLN(0)=$E($G(^TMP($J,"GMRGNAR","NURORD",+NURSORD(INTER),1)),3,38),(ISW(0),ISW,ISW(1))=1
- B E I INTER'="" S ISW(1)=ISW(1)+1,PRORD=$G(^TMP($J,"GMRGNAR","NURORD",+NURSORD(INTER),ISW(1)+1)),NURPLN(0)=$G(^TMP($J,"GMRGNAR","NURORD",+NURSORD(INTER),ISW(1)))
- I $G(PRPROB)="" S PSW=0
- I $G(PRORD)="" S ISW=0
- I ($Y>(IOSL-6)) D HEADER^NURCAS0 Q:NURQUIT D HEADER1^NURCAS0,AR
- W ! W:($D(NURPLN)#2) ?$S('PSW(0):2,1:0),$E($P(NURPLN,U),1,28) W ?30,$G(NURSEVDT) S NURSEVDT=" " W:$D(NURPLN(0)) ?47,NURPLN(0) S (ISW(0),PSW(0))=0 K NURPLN
- Q
- AR W !,"PATIENT PROBLEMS",?30,"EVALUATION DATE",?47,"NURSING INTERVENTIONS"
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCAS1 3442 printed Feb 18, 2025@23:46:33 Page 2
- NURCAS1 ;HIRMFO/MD/RM/MD-PATIENT PROBLEM/NURSING INTERVENTION PRINT ;10/2/95
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- +2 SET GMRGRT=$ORDER(^GMRD(124.2,"AA","NURSC",2,"Nursing Care Plan",1,0))
- SET GMRGPDA=0
- +3 FOR REVDAT=0:0
- SET REVDAT=$ORDER(^GMR(124.3,"AA",DFN,GMRGRT,REVDAT))
- if 'REVDAT
- QUIT
- SET GMRGPDA=$ORDER(^GMR(124.3,"AA",DFN,GMRGRT,REVDAT,0))
- IF GMRGPDA
- if '$SELECT('$DATA(^GMR(124.3,GMRGPDA,5))
- QUIT
- SET GMRGPDA=0
- +4 if 'GMRGPDA
- QUIT
- SET NURSCPE=+$ORDER(^NURSC(216.8,"B",GMRGPDA,0))
- +5 KILL NURSPROB,NURSORD,^TMP($JOB,"GMRGNAR"),^TMP($JOB,"NURPROB")
- +6 FOR PROB=0:0
- SET PROB=$ORDER(^NURSC(216.8,NURSCPE,"EVAL","AA",PROB))
- if PROB'>0
- QUIT
- SET REVDATE=+$ORDER(^(PROB,0))
- SET DA=+$ORDER(^(REVDATE,0))
- IF $DATA(^NURSC(216.8,NURSCPE,"EVAL",DA,0))
- IF '$PIECE(^(0),"^",4)
- DO PROB
- +7 DO NOW^%DTC
- SET GMRGPDT=%
- FOR INTER=0:0
- SET INTER=$ORDER(^NURSC(216.8,NURSCPE,"ORD","AA",INTER))
- if INTER'>0
- QUIT
- SET REVDATE=+$ORDER(^(INTER,0))
- SET DA=+$ORDER(^(REVDATE,0))
- IF $DATA(^NURSC(216.8,NURSCPE,"ORD",DA,0))
- IF '$PIECE(^(0),"^",3)
- DO INTER
- +8 SET (ISW,PSW)=0
- SET (ISW(0),PSW(0))=1
- SET (INTER,PROB)=""
- DO AR
- FOR NX=1:1
- SET INTER=$SELECT(NX=1!(NX'=1&(INTER'="")&'ISW):$ORDER(NURSORD(INTER)),1:INTER)
- SET PROB=$SELECT(NX=1!(NX'=1&(PROB'="")&'PSW):$ORDER(NURSPROB(PROB)),1:PROB)
- if INTER=""&(PROB="")
- QUIT
- DO FORMAT
- if NURQUIT
- QUIT
- +9 KILL ^TMP($JOB,"GMRGNAR"),^TMP($JOB,"NURPROB")
- +10 QUIT
- PROB ;PATIENT PROBLEM ARRAY
- +1 SET NURPROB=$PIECE($GET(^GMRD(124.2,PROB,0)),"^")
- if '$LENGTH(NURPROB)!'$DATA(^GMR(124.3,GMRGPDA,1,"ALIST",PROB))
- QUIT
- +2 SET P=+$ORDER(^GMR(124.3,GMRGPDA,1,"B",PROB,0))
- SET GMRGXPRT=NURPROB
- SET GMRGXPRT(0)=$SELECT($DATA(^GMR(124.3,GMRGPDA,1,P,0)):$PIECE(^(0),"^",2),1:"")
- SET GMRGXPRT(1)="^^0^^1"
- DO EN1^GMRGRUT2
- SET PRPROB=GMRGXPRT
- KILL GMRGXPRT
- +3 SET NURSPROB(PRPROB)=PROB
- +4 FOR NX=1:1
- SET GMRGLEN=$SELECT(NX=1:38,1:36)
- SET GMRGPLN=PRPROB
- DO FITLINE^GMRGRUT1
- SET ^TMP($JOB,"NURPROB",PROB,NX)=GMRGPLN(0)
- SET PRPROB=GMRGPLN(1)
- if PRPROB=""
- QUIT
- +5 QUIT
- INTER ;NURSING INTERVENTION ARRAY
- +1 SET NURORD=$PIECE($GET(^GMRD(124.2,INTER,0)),"^")
- if '$LENGTH(NURORD)!'$DATA(^GMR(124.3,GMRGPDA,1,"ALIST",INTER))
- QUIT
- +2 SET P=+$ORDER(^GMR(124.3,GMRGPDA,1,"B",INTER,0))
- SET GMRGXPRT=NURORD
- SET GMRGXPRT(0)=$SELECT($DATA(^GMR(124.3,GMRGPDA,1,P,0)):$PIECE(^(0),"^",2),1:"")
- SET GMRGXPRT(1)="^^0^^1"
- DO EN1^GMRGRUT2
- SET NURORD=GMRGXPRT
- KILL GMRGXPRT
- +3 SET NURSORD(NURORD)=INTER
- +4 SET GMRGPAR=INTER
- SET GMRGPAR(0)="0^"_(IOM-34)_"^2^NURORD"
- DO EN1^GMRGPNBL
- +5 QUIT
- FORMAT ;PATIENT PROBLEM/NURSING INTERVENTION DISPLAY
- +1 if PROB'=""
- Begin DoDot:1
- +2 FOR RVDT=0:0
- SET RVDT=$ORDER(^NURSC(216.8,NURSCPE,"EVAL","AA",NURSPROB(PROB),RVDT))
- if RVDT'>0
- QUIT
- SET IEN=$ORDER(^NURSC(216.8,NURSCPE,"EVAL","AA",NURSPROB(PROB),RVDT,0))
- IF IEN>0
- Begin DoDot:2
- +3 SET XX=$GET(^NURSC(216.8,NURSCPE,"EVAL",IEN,0))
- SET Y=$PIECE(XX,U,5)
- DO DD^%DT
- SET NURSEVDT=Y
- +4 QUIT
- End DoDot:2
- QUIT
- +5 QUIT
- End DoDot:1
- +6 IF PROB'=""
- IF 'PSW
- SET PRPROB=$GET(^TMP($JOB,"NURPROB",+NURSPROB(PROB),2))
- SET NURPLN=$GET(^TMP($JOB,"NURPROB",+NURSPROB(PROB),1))_"^"_NURSEVDT
- SET (PSW(0),PSW,PSW(1))=1
- +7 IF '$TEST
- IF PROB'=""
- SET PSW(1)=PSW(1)+1
- SET PRPROB=$GET(^TMP($JOB,"NURPROB",+NURSPROB(PROB),PSW(1)+1))
- SET NURPLN=$GET(^TMP($JOB,"NURPROB",+NURSPROB(PROB),PSW(1)))_"^"_NURSEVDT
- +8 IF INTER'=""
- IF 'ISW
- SET PRORD=$GET(^TMP($JOB,"GMRGNAR","NURORD",+NURSORD(INTER),2))
- SET NURPLN(0)=$EXTRACT($GET(^TMP($JOB,"GMRGNAR","NURORD",+NURSORD(INTER),1)),3,38)
- SET (ISW(0),ISW,ISW(1))=1
- B IF '$TEST
- IF INTER'=""
- SET ISW(1)=ISW(1)+1
- SET PRORD=$GET(^TMP($JOB,"GMRGNAR","NURORD",+NURSORD(INTER),ISW(1)+1))
- SET NURPLN(0)=$GET(^TMP($JOB,"GMRGNAR","NURORD",+NURSORD(INTER),ISW(1)))
- +1 IF $GET(PRPROB)=""
- SET PSW=0
- +2 IF $GET(PRORD)=""
- SET ISW=0
- +3 IF ($Y>(IOSL-6))
- DO HEADER^NURCAS0
- if NURQUIT
- QUIT
- DO HEADER1^NURCAS0
- DO AR
- +4 WRITE !
- if ($DATA(NURPLN)#2)
- WRITE ?$SELECT('PSW(0):2,1:0),$EXTRACT($PIECE(NURPLN,U),1,28)
- WRITE ?30,$GET(NURSEVDT)
- SET NURSEVDT=" "
- if $DATA(NURPLN(0))
- WRITE ?47,NURPLN(0)
- SET (ISW(0),PSW(0))=0
- KILL NURPLN
- +5 QUIT
- AR WRITE !,"PATIENT PROBLEMS",?30,"EVALUATION DATE",?47,"NURSING INTERVENTIONS"
- +1 QUIT