- BHSPLAN ;IHS/MSC/MGH - Health Summary for Items associated with Problem list ;31-Dec-2015 17:09;DU
- ;;1.0;HEALTH SUMMARY COMPONENTS;**8,13**;Mar 17,2006;Build 6
- ;===================================================================
- GOALDT ;Active Goals by Date
- N TARGET,X,LINE
- S TARGET=$$TMPGBL
- K @TARGET
- D CKP^GMTSUP Q:$D(GMTSQIT)
- S X=$$CPDT^BTIUPLAN(DFN,TARGET,"G")
- S LINE=0
- F S LINE=$O(@TARGET@(LINE)) Q:LINE="" D
- .D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG W !,"",!
- .W @TARGET@(LINE,0),!
- K TARGET
- Q
- GOALPR ;Active Goals by Problem
- N TARGET,X,LINE
- S TARGET=$$TMPGBL
- K @TARGET
- D CKP^GMTSUP Q:$D(GMTSQIT)
- S X=$$CPPR^BTIUPLAN(DFN,TARGET,"G")
- S LINE=0
- F S LINE=$O(@TARGET@(LINE)) Q:LINE="" D
- .D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG W !,"",!
- .W @TARGET@(LINE,0),!
- K TARGET
- Q
- CPDT ;Active Care Plans by Date
- N TARGET,X,LINE
- S TARGET=$$TMPGBL
- K @TARGET
- D CKP^GMTSUP Q:$D(GMTSQIT)
- S X=$$CPDT^BTIUPLAN(DFN,TARGET,"P")
- S LINE=0
- F S LINE=$O(@TARGET@(LINE)) Q:LINE="" D
- .D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG W !,"",!
- .W @TARGET@(LINE,0),!
- K TARGET
- Q
- CPPR ;Active Care Plans by Problem
- N TARGET,X,LINE
- S TARGET=$$TMPGBL
- K @TARGET
- D CKP^GMTSUP Q:$D(GMTSQIT)
- S X=$$CPPR^BTIUPLAN(DFN,TARGET,"P")
- S LINE=0
- F S LINE=$O(@TARGET@(LINE)) Q:LINE="" D
- .D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG W !,"",!
- .W @TARGET@(LINE,0),!
- K TARGET
- Q
- ICPR ;Inactive Care Plans by Problem
- N TARGET,X,LINE
- S TARGET=$$TMPGBL
- K @TARGET
- D CKP^GMTSUP Q:$D(GMTSQIT)
- S X=$$ICPR^BHSPLST2(DFN,TARGET,"P","I")
- S LINE=0
- F S LINE=$O(@TARGET@(LINE)) Q:LINE="" D
- .D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG W !,"",!
- .W @TARGET@(LINE,0),!
- K TARGET
- Q
- IGPR ;Inactive Goals by Problem
- N TARGET,X,LINE
- S TARGET=$$TMPGBL
- K @TARGET
- D CKP^GMTSUP Q:$D(GMTSQIT)
- S X=$$ICPR^BHSPLST2(DFN,TARGET,"G","I")
- S LINE=0
- F S LINE=$O(@TARGET@(LINE)) Q:LINE="" D
- .D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG W !,"",!
- .W @TARGET@(LINE,0),!
- K TARGET
- Q
- BCPR ;Inactive and active care plans by problem
- N TARGET,X,LINE
- S TARGET=$$TMPGBL
- K @TARGET
- D CKP^GMTSUP Q:$D(GMTSQIT)
- S X=$$ICPR^BHSPLST2(DFN,TARGET,"P","B")
- S LINE=0
- F S LINE=$O(@TARGET@(LINE)) Q:LINE="" D
- .D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG W !,"",!
- .W @TARGET@(LINE,0),!
- K TARGET
- Q
- BGPR ; Inactive and active goals by problem
- N TARGET,X,LINE
- S TARGET=$$TMPGBL
- K @TARGET
- D CKP^GMTSUP Q:$D(GMTSQIT)
- S X=$$ICPR^BHSPLST2(DFN,TARGET,"G","B")
- S LINE=0
- F S LINE=$O(@TARGET@(LINE)) Q:LINE="" D
- .D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG W !,"",!
- .W @TARGET@(LINE,0),!
- K TARGET
- Q
- TMPGBL() ;EP
- K ^TMP("BHSPL",$J) Q $NA(^($J))
- BHSPLAN ;IHS/MSC/MGH - Health Summary for Items associated with Problem list ;31-Dec-2015 17:09;DU
- +1 ;;1.0;HEALTH SUMMARY COMPONENTS;**8,13**;Mar 17,2006;Build 6
- +2 ;===================================================================
- GOALDT ;Active Goals by Date
- +1 NEW TARGET,X,LINE
- +2 SET TARGET=$$TMPGBL
- +3 KILL @TARGET
- +4 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +5 SET X=$$CPDT^BTIUPLAN(DFN,TARGET,"G")
- +6 SET LINE=0
- +7 FOR
- SET LINE=$ORDER(@TARGET@(LINE))
- IF LINE=""
- QUIT
- Begin DoDot:1
- +8 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF GMTSNPG
- WRITE !,"",!
- +9 WRITE @TARGET@(LINE,0),!
- End DoDot:1
- +10 KILL TARGET
- +11 QUIT
- GOALPR ;Active Goals by Problem
- +1 NEW TARGET,X,LINE
- +2 SET TARGET=$$TMPGBL
- +3 KILL @TARGET
- +4 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +5 SET X=$$CPPR^BTIUPLAN(DFN,TARGET,"G")
- +6 SET LINE=0
- +7 FOR
- SET LINE=$ORDER(@TARGET@(LINE))
- IF LINE=""
- QUIT
- Begin DoDot:1
- +8 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF GMTSNPG
- WRITE !,"",!
- +9 WRITE @TARGET@(LINE,0),!
- End DoDot:1
- +10 KILL TARGET
- +11 QUIT
- CPDT ;Active Care Plans by Date
- +1 NEW TARGET,X,LINE
- +2 SET TARGET=$$TMPGBL
- +3 KILL @TARGET
- +4 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +5 SET X=$$CPDT^BTIUPLAN(DFN,TARGET,"P")
- +6 SET LINE=0
- +7 FOR
- SET LINE=$ORDER(@TARGET@(LINE))
- IF LINE=""
- QUIT
- Begin DoDot:1
- +8 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF GMTSNPG
- WRITE !,"",!
- +9 WRITE @TARGET@(LINE,0),!
- End DoDot:1
- +10 KILL TARGET
- +11 QUIT
- CPPR ;Active Care Plans by Problem
- +1 NEW TARGET,X,LINE
- +2 SET TARGET=$$TMPGBL
- +3 KILL @TARGET
- +4 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +5 SET X=$$CPPR^BTIUPLAN(DFN,TARGET,"P")
- +6 SET LINE=0
- +7 FOR
- SET LINE=$ORDER(@TARGET@(LINE))
- IF LINE=""
- QUIT
- Begin DoDot:1
- +8 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF GMTSNPG
- WRITE !,"",!
- +9 WRITE @TARGET@(LINE,0),!
- End DoDot:1
- +10 KILL TARGET
- +11 QUIT
- ICPR ;Inactive Care Plans by Problem
- +1 NEW TARGET,X,LINE
- +2 SET TARGET=$$TMPGBL
- +3 KILL @TARGET
- +4 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +5 SET X=$$ICPR^BHSPLST2(DFN,TARGET,"P","I")
- +6 SET LINE=0
- +7 FOR
- SET LINE=$ORDER(@TARGET@(LINE))
- IF LINE=""
- QUIT
- Begin DoDot:1
- +8 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF GMTSNPG
- WRITE !,"",!
- +9 WRITE @TARGET@(LINE,0),!
- End DoDot:1
- +10 KILL TARGET
- +11 QUIT
- IGPR ;Inactive Goals by Problem
- +1 NEW TARGET,X,LINE
- +2 SET TARGET=$$TMPGBL
- +3 KILL @TARGET
- +4 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +5 SET X=$$ICPR^BHSPLST2(DFN,TARGET,"G","I")
- +6 SET LINE=0
- +7 FOR
- SET LINE=$ORDER(@TARGET@(LINE))
- IF LINE=""
- QUIT
- Begin DoDot:1
- +8 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF GMTSNPG
- WRITE !,"",!
- +9 WRITE @TARGET@(LINE,0),!
- End DoDot:1
- +10 KILL TARGET
- +11 QUIT
- BCPR ;Inactive and active care plans by problem
- +1 NEW TARGET,X,LINE
- +2 SET TARGET=$$TMPGBL
- +3 KILL @TARGET
- +4 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +5 SET X=$$ICPR^BHSPLST2(DFN,TARGET,"P","B")
- +6 SET LINE=0
- +7 FOR
- SET LINE=$ORDER(@TARGET@(LINE))
- IF LINE=""
- QUIT
- Begin DoDot:1
- +8 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF GMTSNPG
- WRITE !,"",!
- +9 WRITE @TARGET@(LINE,0),!
- End DoDot:1
- +10 KILL TARGET
- +11 QUIT
- BGPR ; Inactive and active goals by problem
- +1 NEW TARGET,X,LINE
- +2 SET TARGET=$$TMPGBL
- +3 KILL @TARGET
- +4 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +5 SET X=$$ICPR^BHSPLST2(DFN,TARGET,"G","B")
- +6 SET LINE=0
- +7 FOR
- SET LINE=$ORDER(@TARGET@(LINE))
- IF LINE=""
- QUIT
- Begin DoDot:1
- +8 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- IF GMTSNPG
- WRITE !,"",!
- +9 WRITE @TARGET@(LINE,0),!
- End DoDot:1
- +10 KILL TARGET
- +11 QUIT
- TMPGBL() ;EP
- +1 KILL ^TMP("BHSPL",$JOB)
- QUIT $NAME(^($JOB))
