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))
