- NURCPP1 ;HIRMFO/JH/RM-NURSING CARE PLAN DATA OUTPUT part 1 ;1/13/92
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- ; This is the Patient Problem Listing,Data Processor,Output Routine
- EN1 ;
- D NOW^%DTC S Y=% D D^DIQ S NURSDAT=$P(Y,":",1,2),NURSISW=1,NURSSP=0,NURSLIN("-")="",$P(NURSLIN("-"),"-",IOM)="-",NURSPAG=1,(NURSLCNT,NURSSW1)=0 D SPACES^NURCPP3
- S NURSMED="Diagnosis: "_$E(NURSDIAG_NURSSS,1,37)_" "_"Physician: "_NURSPROV
- S NURSHED=$E(NURSPNAM_NURSSS,1,20)_" "_NURSSSN_" "_NURAGE_" "_$E(NURSWD_NURSSS,1,8)_" "_$E(NURSRB_NURSSS,1,10)_" "_$E(NURSREL_NURSSS,1,4)_" "_NURSMAR
- ;
- S NURSO=0,NURSP(1)="" F NURSX=0:0 S NURSP(1)=$O(NURSPRB(NURSP(1))) Q:NURSP(1)="" F NURSP=0:0 S NURSP=$O(NURSPRB(NURSP(1),NURSP)) Q:NURSP'>0 D PROB
- F X=0:0 Q:$S('$D(^TMP($J,"NURSDATA",NURSO)):1,^(NURSO)'="":1,1:0) K ^(NURSO) S NURSO=NURSO-1
- I NURSO'>0 U IO S NURSISW=0,ANS="" D HEADER^NURCPP3 W !!,"THERE IS NO DATA FOR THIS REPORT" S NURSISW=2,NURSLCNT=NURSLCNT+2 D HEADER^NURCPP3 Q
- U IO D GETOUPT^NURCPP3
- ;
- Q
- ;
- PROB ; CHECK FOR PROBLEM AND EVALUATION DATE
- K NURSLVD F X=1:1:2 S NURSO=NURSO+1,^TMP($J,"NURSDATA",NURSO)=""
- S GMRGXPRT=$S($D(^GMRD(124.2,NURSP,0)):$P(^(0),"^"),1:""),NURSP(0)=$O(^GMR(124.3,GMRGPDA,1,"B",NURSP,0)),GMRGXPRT(0)=$S(NURSP(0)'>0:"",$D(^GMR(124.3,GMRGPDA,1,NURSP(0),0)):$P(^(0),"^",2),1:""),GMRGXPRT(1)="^^0^^1" D EN1^GMRGRUT2
- S GMRGPLN=GMRGXPRT,GMRGLEN=50 D FITLINE^GMRGRUT1 S ^TMP($J,"NURSDATA",NURSO)=GMRGPLN(0)
- F NURSE(0)=0:0 S NURSE(0)=$O(^TMP($J,"NURSDATE",NURSP,NURSE(0))) Q:NURSE(0)'>0 F NURSE=0:0 S NURSE=$O(^TMP($J,"NURSDATE",NURSP,NURSE(0),NURSE)) Q:NURSE'>0 D PROB1
- I ^TMP($J,"NURSDATA",NURSO)'="" S NURSO=NURSO+1,^TMP($J,"NURSDATA",NURSO)=""
- F NURSE=0:0 Q:GMRGPLN(1)="" S GMRGLEN=50,GMRGPLN=GMRGPLN(1) D FITLINE^GMRGRUT1 S ^TMP($J,"NURSDATA",NURSO)=GMRGPLN(0),NURSO=NURSO+1,^(NURSO)=""
- G PROB3
- ;
- PROB1 ;
- S X=$S($D(^TMP($J,"NURSDATE",NURSP,NURSE(0),NURSE)):^(NURSE),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)_")",1:" "),NURSRN=$E($S($D(^VA(200,+$P(X,"^",3),0)):$P($P(^(0),"^"),","),1:"")_" ",1,10)
- I '$D(NURSLVD) S NURSLVD=("^R^S^U^"[("^"_$P(X,"^",4)_"^")) ; switch to determine if problem inactive
- S X=^TMP($J,"NURSDATA",NURSO),^(NURSO)=X_$E(NURSSS,1,57-$L(X))_NURSH3_Y_NURSTAT_NURSP3_NURSRN,X=""
- I GMRGPLN(1)'="" S GMRGPLN=GMRGPLN(1),GMRGLEN=50 D FITLINE^GMRGRUT1 S X=GMRGPLN(0)
- S NURSO=NURSO+1,^TMP($J,"NURSDATA",NURSO)=X
- Q
- PROB3 F NURSOT=0:0 S NURSOT=$O(^TMP($J,"NURSOT",NURSP,NURSOT)) Q:NURSOT'>0 S NURSO=NURSO+1,^TMP($J,"NURSDATA",NURSO)="" D OTHER
- ;
- I $D(^TMP($J,"NURSDATA",NURSO)),^(NURSO)'="" S NURSO=NURSO+1,^(NURSO)=""
- S NURSO=NURSO+1,^TMP($J,"NURSDATA",NURSO)=""
- K NURSB("G"),NURSB("I") F NURSE=0:0 S NURSE=$O(^GMRD(124.2,NURSP,1,"B",NURSE)) Q:NURSE'>0 S NURSE(0)=$S($D(^GMRD(124.2,NURSE,0)):$P(^(0),"^",4),1:"") S:NURSE(0)=NURSGCK NURSB("G",NURSE)="" S:NURSE(0)=NURSICK NURSB("I",NURSE)=""
- D ^NURCPP2
- S NURSP(0)=$O(^GMR(124.3,GMRGPDA,1,"B",NURSP,0)) I NURSP(0)>0,$D(^GMR(124.3,GMRGPDA,1,NURSP(0),"ADD")),^("ADD")]"" S NURSLGT=47,NURSADD=^("ADD"),NURSO=NURSO+1,^TMP($J,"NURSDATA",NURSO)="" D FORMAT^NURCPP4
- Q
- ;
- OTHER ; PRINT OTHER INFO ABOUT PROBLEM
- F NURST=0:0 S NURST=$O(^TMP($J,"GMRGNAR","R",NURSOT,NURST)) Q:NURST'>0 D STOT
- Q
- STOT ;
- S X=^TMP($J,"GMRGNAR","R",NURSOT,NURST)
- S ^TMP($J,"NURSDATA",NURSO)=" "_X_$E(NURSSS,1,57-$L(X)),NURSO=NURSO+1,^TMP($J,"NURSDATA",NURSO)=""
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCPP1 3477 printed Jan 18, 2025@03:21:47 Page 2
- NURCPP1 ;HIRMFO/JH/RM-NURSING CARE PLAN DATA OUTPUT part 1 ;1/13/92
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- +2 ; This is the Patient Problem Listing,Data Processor,Output Routine
- EN1 ;
- +1 DO NOW^%DTC
- SET Y=%
- DO D^DIQ
- SET NURSDAT=$PIECE(Y,":",1,2)
- SET NURSISW=1
- SET NURSSP=0
- SET NURSLIN("-")=""
- SET $PIECE(NURSLIN("-"),"-",IOM)="-"
- SET NURSPAG=1
- SET (NURSLCNT,NURSSW1)=0
- DO SPACES^NURCPP3
- +2 SET NURSMED="Diagnosis: "_$EXTRACT(NURSDIAG_NURSSS,1,37)_" "_"Physician: "_NURSPROV
- +3 SET NURSHED=$EXTRACT(NURSPNAM_NURSSS,1,20)_" "_NURSSSN_" "_NURAGE_" "_$EXTRACT(NURSWD_NURSSS,1,8)_" "_$EXTRACT(NURSRB_NURSSS,1,10)_" "_$EXTRACT(NURSREL_NURSSS,1,4)_" "_NURSMAR
- +4 ;
- +5 SET NURSO=0
- SET NURSP(1)=""
- FOR NURSX=0:0
- SET NURSP(1)=$ORDER(NURSPRB(NURSP(1)))
- if NURSP(1)=""
- QUIT
- FOR NURSP=0:0
- SET NURSP=$ORDER(NURSPRB(NURSP(1),NURSP))
- if NURSP'>0
- QUIT
- DO PROB
- +6 FOR X=0:0
- if $SELECT('$DATA(^TMP($JOB,"NURSDATA",NURSO))
- QUIT
- KILL ^(NURSO)
- SET NURSO=NURSO-1
- +7 IF NURSO'>0
- USE IO
- SET NURSISW=0
- SET ANS=""
- DO HEADER^NURCPP3
- WRITE !!,"THERE IS NO DATA FOR THIS REPORT"
- SET NURSISW=2
- SET NURSLCNT=NURSLCNT+2
- DO HEADER^NURCPP3
- QUIT
- +8 USE IO
- DO GETOUPT^NURCPP3
- +9 ;
- +10 QUIT
- +11 ;
- PROB ; CHECK FOR PROBLEM AND EVALUATION DATE
- +1 KILL NURSLVD
- FOR X=1:1:2
- SET NURSO=NURSO+1
- SET ^TMP($JOB,"NURSDATA",NURSO)=""
- +2 SET GMRGXPRT=$SELECT($DATA(^GMRD(124.2,NURSP,0)):$PIECE(^(0),"^"),1:"")
- SET NURSP(0)=$ORDER(^GMR(124.3,GMRGPDA,1,"B",NURSP,0))
- SET GMRGXPRT(0)=$SELECT(NURSP(0)'>0:"",$DATA(^GMR(124.3,GMRGPDA,1,NURSP(0),0)):$PIECE(^(0),"^",2),1:"")
- SET GMRGXPRT(1)="^^0^^1"
- DO EN1^GMRGRUT2
- +3 SET GMRGPLN=GMRGXPRT
- SET GMRGLEN=50
- DO FITLINE^GMRGRUT1
- SET ^TMP($JOB,"NURSDATA",NURSO)=GMRGPLN(0)
- +4 FOR NURSE(0)=0:0
- SET NURSE(0)=$ORDER(^TMP($JOB,"NURSDATE",NURSP,NURSE(0)))
- if NURSE(0)'>0
- QUIT
- FOR NURSE=0:0
- SET NURSE=$ORDER(^TMP($JOB,"NURSDATE",NURSP,NURSE(0),NURSE))
- if NURSE'>0
- QUIT
- DO PROB1
- +5 IF ^TMP($JOB,"NURSDATA",NURSO)'=""
- SET NURSO=NURSO+1
- SET ^TMP($JOB,"NURSDATA",NURSO)=""
- +6 FOR NURSE=0:0
- if GMRGPLN(1)=""
- QUIT
- SET GMRGLEN=50
- SET GMRGPLN=GMRGPLN(1)
- DO FITLINE^GMRGRUT1
- SET ^TMP($JOB,"NURSDATA",NURSO)=GMRGPLN(0)
- SET NURSO=NURSO+1
- SET ^(NURSO)=""
- +7 GOTO PROB3
- +8 ;
- PROB1 ;
- +1 SET X=$SELECT($DATA(^TMP($JOB,"NURSDATE",NURSP,NURSE(0),NURSE)):^(NURSE),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)_")",1:" ")
- SET NURSRN=$EXTRACT($SELECT($DATA(^VA(200,+$PIECE(X,"^",3),0)):$PIECE($PIECE(^(0),"^"),","),1:"")_" ",1,10)
- +3 ; switch to determine if problem inactive
- IF '$DATA(NURSLVD)
- SET NURSLVD=("^R^S^U^"[("^"_$PIECE(X,"^",4)_"^"))
- +4 SET X=^TMP($JOB,"NURSDATA",NURSO)
- SET ^(NURSO)=X_$EXTRACT(NURSSS,1,57-$LENGTH(X))_NURSH3_Y_NURSTAT_NURSP3_NURSRN
- SET X=""
- +5 IF GMRGPLN(1)'=""
- SET GMRGPLN=GMRGPLN(1)
- SET GMRGLEN=50
- DO FITLINE^GMRGRUT1
- SET X=GMRGPLN(0)
- +6 SET NURSO=NURSO+1
- SET ^TMP($JOB,"NURSDATA",NURSO)=X
- +7 QUIT
- PROB3 FOR NURSOT=0:0
- SET NURSOT=$ORDER(^TMP($JOB,"NURSOT",NURSP,NURSOT))
- if NURSOT'>0
- QUIT
- SET NURSO=NURSO+1
- SET ^TMP($JOB,"NURSDATA",NURSO)=""
- DO OTHER
- +1 ;
- +2 IF $DATA(^TMP($JOB,"NURSDATA",NURSO))
- IF ^(NURSO)'=""
- SET NURSO=NURSO+1
- SET ^(NURSO)=""
- +3 SET NURSO=NURSO+1
- SET ^TMP($JOB,"NURSDATA",NURSO)=""
- +4 KILL NURSB("G"),NURSB("I")
- FOR NURSE=0:0
- SET NURSE=$ORDER(^GMRD(124.2,NURSP,1,"B",NURSE))
- if NURSE'>0
- QUIT
- SET NURSE(0)=$SELECT($DATA(^GMRD(124.2,NURSE,0)):$PIECE(^(0),"^",4),1:"")
- if NURSE(0)=NURSGCK
- SET NURSB("G",NURSE)=""
- if NURSE(0)=NURSICK
- SET NURSB("I",NURSE)=""
- +5 DO ^NURCPP2
- +6 SET NURSP(0)=$ORDER(^GMR(124.3,GMRGPDA,1,"B",NURSP,0))
- IF NURSP(0)>0
- IF $DATA(^GMR(124.3,GMRGPDA,1,NURSP(0),"ADD"))
- IF ^("ADD")]""
- SET NURSLGT=47
- SET NURSADD=^("ADD")
- SET NURSO=NURSO+1
- SET ^TMP($JOB,"NURSDATA",NURSO)=""
- DO FORMAT^NURCPP4
- +7 QUIT
- +8 ;
- OTHER ; PRINT OTHER INFO ABOUT PROBLEM
- +1 FOR NURST=0:0
- SET NURST=$ORDER(^TMP($JOB,"GMRGNAR","R",NURSOT,NURST))
- if NURST'>0
- QUIT
- DO STOT
- +2 QUIT
- STOT ;
- +1 SET X=^TMP($JOB,"GMRGNAR","R",NURSOT,NURST)
- +2 SET ^TMP($JOB,"NURSDATA",NURSO)=" "_X_$EXTRACT(NURSSS,1,57-$LENGTH(X))
- SET NURSO=NURSO+1
- SET ^TMP($JOB,"NURSDATA",NURSO)=""
- +3 QUIT