- NURCPP6 ;HIRMFO/JH-NURSING CARE PLAN DATA OUTPUT Part 2 ;9/18/89
- ;;4.0;NURSING SERVICE;;Apr 25, 1997
- ; This is the Patient Problem Listing,Data Processor,Output Routine
- ; 132 Col. Compressed print
- G:'$O(NURSB("G","")) 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
- . F NURSG(1)=0:0 S NURSG(1)=$O(^TMP($J,"GMRGNAR",NURSRTK,NURSG(1))) Q:NURSG(1)'>0 D AG1
- . I $D(^GMR(124.3,GMRGPDA,1,NURSB,"ADD")),^("ADD")]"" S NURSADD=^("ADD"),NURSLGT=1 S NURSRET=2,NURSO4=NURSO1 D FORMAT^NURCPP7 S NURSO1=NURSO4
- . Q
- ;
- ARG G:'$O(NURSB("I","")) 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
- . 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=1,NURSADD=^("ADD") S NURSRET=3,NURSO4=NURSO2 D FORMAT^NURCPP7 S NURSO2=NURSO4
- . Q
- ARI Q
- ;
- AL1 ;
- S NURSC=$S('$D(^GMRD(124.2,+NURSI(1),0)):"",$P(^(0),"^",4)=NURSINCK:1,1:0) D ILP1^NURCPP7:'NURSC I NURSC S NURSA=0,NURSI=NURSI(1),NURSI(0)=NURSRTK D INTER^NURCPP7
- Q
- AG1 ;
- S NURSC=$S('$D(^GMRD(124.2,+NURSG(1),0)):"",$P(^(0),"^",4)=NURSGOCK:1,1:0) D GLP1^NURCPP8:'NURSC I NURSC S NURSA=0,NURSG=NURSG(1),NURSG(0)=NURSRTK D GOAL^NURCPP8
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HNURCPP6 1617 printed Feb 18, 2025@23:47:07 Page 2
- NURCPP6 ;HIRMFO/JH-NURSING CARE PLAN DATA OUTPUT Part 2 ;9/18/89
- +1 ;;4.0;NURSING SERVICE;;Apr 25, 1997
- +2 ; This is the Patient Problem Listing,Data Processor,Output Routine
- +3 ; 132 Col. Compressed print
- +4 if '$ORDER(NURSB("G",""))
- GOTO ARG
- +5 FOR NURSRTK=0:0
- SET NURSRTK=$ORDER(NURSB("G",NURSRTK))
- if NURSRTK'>0
- QUIT
- Begin DoDot:1
- +6 if '(NURSPLN="C"&$DATA(^GMR(124.3,GMRGPDA,1,"ALIST",NURSRTK))!(NURSPLN="A"&$DATA(^GMR(124.3,GMRGPDA,1,"B",NURSRTK))))
- QUIT
- +7 SET NURSB=$ORDER(^GMR(124.3,GMRGPDA,1,"B",NURSRTK,0))
- if NURSB'>0
- QUIT
- +8 FOR NURSG(1)=0:0
- SET NURSG(1)=$ORDER(^TMP($JOB,"GMRGNAR",NURSRTK,NURSG(1)))
- if NURSG(1)'>0
- QUIT
- DO AG1
- +9 IF $DATA(^GMR(124.3,GMRGPDA,1,NURSB,"ADD"))
- IF ^("ADD")]""
- SET NURSADD=^("ADD")
- SET NURSLGT=1
- SET NURSRET=2
- SET NURSO4=NURSO1
- DO FORMAT^NURCPP7
- SET NURSO1=NURSO4
- +10 QUIT
- End DoDot:1
- +11 ;
- ARG if '$ORDER(NURSB("I",""))
- 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 FOR NURSI(1)=0:0
- SET NURSI(1)=$ORDER(^TMP($JOB,"GMRGNAR",NURSRTK,NURSI(1)))
- if NURSI(1)'>0
- QUIT
- DO AL1
- +5 IF $DATA(^GMR(124.3,GMRGPDA,1,NURSB,"ADD"))
- IF ^("ADD")]""
- SET NURSLGT=1
- SET NURSADD=^("ADD")
- SET NURSRET=3
- SET NURSO4=NURSO2
- DO FORMAT^NURCPP7
- SET NURSO2=NURSO4
- +6 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^NURCPP7
- IF NURSC
- SET NURSA=0
- SET NURSI=NURSI(1)
- SET NURSI(0)=NURSRTK
- DO INTER^NURCPP7
- +2 QUIT
- AG1 ;
- +1 SET NURSC=$SELECT('$DATA(^GMRD(124.2,+NURSG(1),0)):"",$PIECE(^(0),"^",4)=NURSGOCK:1,1:0)
- if 'NURSC
- DO GLP1^NURCPP8
- IF NURSC
- SET NURSA=0
- SET NURSG=NURSG(1)
- SET NURSG(0)=NURSRTK
- DO GOAL^NURCPP8
- +2 QUIT
