BHSOB ;IHS/MSC/MGH - Health Summary Components for OB file ;12-Jul-2016 12:54;MGH
;;1.0;HEALTH SUMMARY COMPONENTS;**7,9,14**;March 17, 2006;Build 4
;===================================================================
OBALL ;EP - display OB visits, date limits and numbers are applicable
N BHSPAT,V,Y,X,Z,BHSIVD,BHIEN,VIEN,BHSOB,CNT,LINE,BHSOBI,ARRAY,ARRAY2
S BHSPAT=DFN
;Changed this call to use an API from BJPN
N X,TARGET,LINE,Y
S (ARRAY,ARRAY2)="",CNT=0
D PVST^BJPNAPI(DFN,.ARRAY,.ARRAY2)
S X=""
D CKP^GMTSUP Q:$D(GMTSQIT)
F S X=$O(ARRAY(X)) Q:X=""!(CNT>GMTSNDM) D
.S VIEN=$G(ARRAY(X))
.S CNT=CNT+1
.S V=$$GET1^DIQ(9000010,VIEN,.01,"E")
.W !,"Visit: "_V,!
.S TARGET=$$TMPGBL
.S Y=$$VPIP^BJPNAPI(TARGET,DFN,VIEN) ;PEP - Returns Prenatal POV Problems for a Visit
.S LINE=""
.F S LINE=$O(^TMP("BHSOB",$J,LINE)) Q:LINE="" D
..D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG W !,"Visit: "_V,!
..S Z=$G(^TMP("BHSOB",$J,LINE,0))
..W Z,!
;Q
Q
;I '$D(^AUPNVOB("AA",BHSPAT)) Q ;no OB data for this patient
; <DISPLAY>
;K BHSOB
;S BHSOBI=0 F S BHSOBI=$O(^AUPNVOB("AA",BHSPAT,BHSOBI)) Q:BHSOBI="" D
;.S BHSIVD="" F S BHSIVD=$O(^AUPNVOB("AA",BHSPAT,BHSOBI,BHSIVD)) Q:BHSIVD=""!(BHSIVD>GMTSDLM) D
;..S BHIEN=0 F S BHIEN=$O(^AUPNVOB("AA",BHSPAT,BHSOBI,BHSIVD,BHIEN)) Q:'+BHIEN D
;...S VIEN=$P($G(^AUPNVOB(BHIEN,0)),U,3)
;...S BHSOB(BHSIVD)=VIEN ;Save off the visits by date
;;Now loop through the visits and call the API to return all the problems for that visit
;S TARGET=$$TMPGBL
;S BHSIVD="",CNT=0
;D CKP^GMTSUP Q:$D(GMTSQIT)
;F S BHSIVD=$O(BHSOB(BHSIVD)) Q:BHSIVD=""!(BHSIVD>GMTSDLM)!(CNT>GMTSNDM) D
;.S VIEN=$G(BHSOB(BHSIVD))
;.S CNT=CNT+1
;.S X=$$GET1^DIQ(9000010,VIEN,.01,"E")
;.W !,"Visit: "_X,!
;.S TARGET=$$TMPGBL
;.S X=$$VPIP^BJPNAPI(TARGET,DFN,VIEN) PEP - Returns Prenatal POV Problems for a Visit
;.S LINE=""
;.F S LINE=$O(^TMP("BHSOB",$J,LINE)) Q:LINE="" D
;..D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG W !,"Visit",!
;..S Y=$G(^TMP("BHSOB",$J,LINE,0))
;..W Y,!
;Q
APIP ;Get All PIP problems
N X,TARGET,LINE,Y
S TARGET=$$TMPGBL
S X=$$APIP^BJPNAPI(TARGET,DFN,"A")
S LINE=""
F S LINE=$O(^TMP("BHSOB",$J,LINE)) Q:LINE="" D
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W $G(^TMP("BHSOB",$J,LINE,0)),!
Q
CPIP ;Get all active problems for current pregnancy
N X,TARGET,LINE,Y
S TARGET=$$TMPGBL
S X=$$APIP^BJPNAPI(TARGET,DFN,"C")
S LINE=""
F S LINE=$O(^TMP("BHSOB",$J,LINE)) Q:LINE="" D
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W $G(^TMP("BHSOB",$J,LINE,0)),!
Q
NPIP ;Get all active and inactive problems and notes
N X,TARGET,LINE,Y
S TARGET=$$TMPGBL
S X=$$APIP^BJPNAPI(TARGET,DFN,"A",1)
S LINE=""
F S LINE=$O(^TMP("BHSOB",$J,LINE)) Q:LINE="" D
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W $G(^TMP("BHSOB",$J,LINE,0)),!
Q
PIPA ;Get Active problems + visit instructions, goals and care plans
N X,TARGET,LINE,Y
S TARGET=$$TMPGBL
S X=$$PIPA^BJPNAPI(TARGET,DFN,"O")
S LINE=""
F S LINE=$O(^TMP("BHSOB",$J,LINE)) Q:LINE="" D
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W $G(^TMP("BHSOB",$J,LINE,0)),!
Q
PIPN ;Get All PIP problems, goals, care plans, visit instructions
N X,TARGET,LINE,Y
S TARGET=$$TMPGBL
S X=$$PIPN^BJPNAPI(TARGET,DFN,"O")
S LINE=""
F S LINE=$O(^TMP("BHSOB",$J,LINE)) Q:LINE="" D
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W $G(^TMP("BHSOB",$J,LINE,0)),!
Q
PIPC ;Get active problems for current pregnancy plus goals, care plans, visit instructions
N X,TARGET,LINE,Y
S TARGET=$$TMPGBL
S X=$$PIPC^BJPNAPI(TARGET,DFN,"O")
S LINE=""
F S LINE=$O(^TMP("BHSOB",$J,LINE)) Q:LINE="" D
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W $G(^TMP("BHSOB",$J,LINE,0)),!
Q
LPIP ;Get Returns list of all ACTIVE problem entries on the PIP.
;For each problem entry, returns all the visit instructions entered for
;the latest visit for the patient.
N X,TARGET,LINE,Y
S TARGET=$$TMPGBL
S X=$$LPIP^BJPNAPI(TARGET,DFN,1,"O")
S LINE=""
F S LINE=$O(^TMP("BHSOB",$J,LINE)) Q:LINE="" D
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W $G(^TMP("BHSOB",$J,LINE,0)),!
Q
VPIP ;Get All PIP problems for the specified visit and latest visit instructions
N X,TARGET,LINE,Y
S TARGET=$$TMPGBL
S X=$$VPIP^BJPNAPI(TARGET,DFN,"",1,"O")
S LINE=""
F S LINE=$O(^TMP("BHSOB",$J,LINE)) Q:LINE="" D
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W $G(^TMP("BHSOB",$J,LINE,0)),!
Q
VPOV ;Get All PIP problems used as a POV for the visit and associated visit instructions
N X,TARGET,LINE,Y
S TARGET=$$TMPGBL
S X=$$VPOV^BJPNAPI(TARGET,DFN,"","O")
S LINE=""
F S LINE=$O(^TMP("BHSOB",$J,LINE)) Q:LINE="" D
.D CKP^GMTSUP Q:$D(GMTSQIT)
.W $G(^TMP("BHSOB",$J,LINE,0)),!
Q
TMPGBL() ;EP
K ^TMP("BHSOB",$J) Q $NA(^($J))
BHSOB ;IHS/MSC/MGH - Health Summary Components for OB file ;12-Jul-2016 12:54;MGH
+1 ;;1.0;HEALTH SUMMARY COMPONENTS;**7,9,14**;March 17, 2006;Build 4
+2 ;===================================================================
OBALL ;EP - display OB visits, date limits and numbers are applicable
+1 NEW BHSPAT,V,Y,X,Z,BHSIVD,BHIEN,VIEN,BHSOB,CNT,LINE,BHSOBI,ARRAY,ARRAY2
+2 SET BHSPAT=DFN
+3 ;Changed this call to use an API from BJPN
+4 NEW X,TARGET,LINE,Y
+5 SET (ARRAY,ARRAY2)=""
SET CNT=0
+6 DO PVST^BJPNAPI(DFN,.ARRAY,.ARRAY2)
+7 SET X=""
+8 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+9 FOR
SET X=$ORDER(ARRAY(X))
IF X=""!(CNT>GMTSNDM)
QUIT
Begin DoDot:1
+10 SET VIEN=$GET(ARRAY(X))
+11 SET CNT=CNT+1
+12 SET V=$$GET1^DIQ(9000010,VIEN,.01,"E")
+13 WRITE !,"Visit: "_V,!
+14 SET TARGET=$$TMPGBL
+15 ;PEP - Returns Prenatal POV Problems for a Visit
SET Y=$$VPIP^BJPNAPI(TARGET,DFN,VIEN)
+16 SET LINE=""
+17 FOR
SET LINE=$ORDER(^TMP("BHSOB",$JOB,LINE))
IF LINE=""
QUIT
Begin DoDot:2
+18 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
IF GMTSNPG
WRITE !,"Visit: "_V,!
+19 SET Z=$GET(^TMP("BHSOB",$JOB,LINE,0))
+20 WRITE Z,!
End DoDot:2
End DoDot:1
+21 ;Q
+22 QUIT
+23 ;I '$D(^AUPNVOB("AA",BHSPAT)) Q ;no OB data for this patient
+24 ; <DISPLAY>
+25 ;K BHSOB
+26 ;S BHSOBI=0 F S BHSOBI=$O(^AUPNVOB("AA",BHSPAT,BHSOBI)) Q:BHSOBI="" D
+27 ;.S BHSIVD="" F S BHSIVD=$O(^AUPNVOB("AA",BHSPAT,BHSOBI,BHSIVD)) Q:BHSIVD=""!(BHSIVD>GMTSDLM) D
+28 ;..S BHIEN=0 F S BHIEN=$O(^AUPNVOB("AA",BHSPAT,BHSOBI,BHSIVD,BHIEN)) Q:'+BHIEN D
+29 ;...S VIEN=$P($G(^AUPNVOB(BHIEN,0)),U,3)
+30 ;...S BHSOB(BHSIVD)=VIEN ;Save off the visits by date
+31 ;;Now loop through the visits and call the API to return all the problems for that visit
+32 ;S TARGET=$$TMPGBL
+33 ;S BHSIVD="",CNT=0
+34 ;D CKP^GMTSUP Q:$D(GMTSQIT)
+35 ;F S BHSIVD=$O(BHSOB(BHSIVD)) Q:BHSIVD=""!(BHSIVD>GMTSDLM)!(CNT>GMTSNDM) D
+36 ;.S VIEN=$G(BHSOB(BHSIVD))
+37 ;.S CNT=CNT+1
+38 ;.S X=$$GET1^DIQ(9000010,VIEN,.01,"E")
+39 ;.W !,"Visit: "_X,!
+40 ;.S TARGET=$$TMPGBL
+41 ;.S X=$$VPIP^BJPNAPI(TARGET,DFN,VIEN) PEP - Returns Prenatal POV Problems for a Visit
+42 ;.S LINE=""
+43 ;.F S LINE=$O(^TMP("BHSOB",$J,LINE)) Q:LINE="" D
+44 ;..D CKP^GMTSUP Q:$D(GMTSQIT) I GMTSNPG W !,"Visit",!
+45 ;..S Y=$G(^TMP("BHSOB",$J,LINE,0))
+46 ;..W Y,!
+47 ;Q
APIP ;Get All PIP problems
+1 NEW X,TARGET,LINE,Y
+2 SET TARGET=$$TMPGBL
+3 SET X=$$APIP^BJPNAPI(TARGET,DFN,"A")
+4 SET LINE=""
+5 FOR
SET LINE=$ORDER(^TMP("BHSOB",$JOB,LINE))
IF LINE=""
QUIT
Begin DoDot:1
+6 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+7 WRITE $GET(^TMP("BHSOB",$JOB,LINE,0)),!
End DoDot:1
+8 QUIT
CPIP ;Get all active problems for current pregnancy
+1 NEW X,TARGET,LINE,Y
+2 SET TARGET=$$TMPGBL
+3 SET X=$$APIP^BJPNAPI(TARGET,DFN,"C")
+4 SET LINE=""
+5 FOR
SET LINE=$ORDER(^TMP("BHSOB",$JOB,LINE))
IF LINE=""
QUIT
Begin DoDot:1
+6 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+7 WRITE $GET(^TMP("BHSOB",$JOB,LINE,0)),!
End DoDot:1
+8 QUIT
NPIP ;Get all active and inactive problems and notes
+1 NEW X,TARGET,LINE,Y
+2 SET TARGET=$$TMPGBL
+3 SET X=$$APIP^BJPNAPI(TARGET,DFN,"A",1)
+4 SET LINE=""
+5 FOR
SET LINE=$ORDER(^TMP("BHSOB",$JOB,LINE))
IF LINE=""
QUIT
Begin DoDot:1
+6 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+7 WRITE $GET(^TMP("BHSOB",$JOB,LINE,0)),!
End DoDot:1
+8 QUIT
PIPA ;Get Active problems + visit instructions, goals and care plans
+1 NEW X,TARGET,LINE,Y
+2 SET TARGET=$$TMPGBL
+3 SET X=$$PIPA^BJPNAPI(TARGET,DFN,"O")
+4 SET LINE=""
+5 FOR
SET LINE=$ORDER(^TMP("BHSOB",$JOB,LINE))
IF LINE=""
QUIT
Begin DoDot:1
+6 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+7 WRITE $GET(^TMP("BHSOB",$JOB,LINE,0)),!
End DoDot:1
+8 QUIT
PIPN ;Get All PIP problems, goals, care plans, visit instructions
+1 NEW X,TARGET,LINE,Y
+2 SET TARGET=$$TMPGBL
+3 SET X=$$PIPN^BJPNAPI(TARGET,DFN,"O")
+4 SET LINE=""
+5 FOR
SET LINE=$ORDER(^TMP("BHSOB",$JOB,LINE))
IF LINE=""
QUIT
Begin DoDot:1
+6 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+7 WRITE $GET(^TMP("BHSOB",$JOB,LINE,0)),!
End DoDot:1
+8 QUIT
PIPC ;Get active problems for current pregnancy plus goals, care plans, visit instructions
+1 NEW X,TARGET,LINE,Y
+2 SET TARGET=$$TMPGBL
+3 SET X=$$PIPC^BJPNAPI(TARGET,DFN,"O")
+4 SET LINE=""
+5 FOR
SET LINE=$ORDER(^TMP("BHSOB",$JOB,LINE))
IF LINE=""
QUIT
Begin DoDot:1
+6 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+7 WRITE $GET(^TMP("BHSOB",$JOB,LINE,0)),!
End DoDot:1
+8 QUIT
LPIP ;Get Returns list of all ACTIVE problem entries on the PIP.
+1 ;For each problem entry, returns all the visit instructions entered for
+2 ;the latest visit for the patient.
+3 NEW X,TARGET,LINE,Y
+4 SET TARGET=$$TMPGBL
+5 SET X=$$LPIP^BJPNAPI(TARGET,DFN,1,"O")
+6 SET LINE=""
+7 FOR
SET LINE=$ORDER(^TMP("BHSOB",$JOB,LINE))
IF LINE=""
QUIT
Begin DoDot:1
+8 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+9 WRITE $GET(^TMP("BHSOB",$JOB,LINE,0)),!
End DoDot:1
+10 QUIT
VPIP ;Get All PIP problems for the specified visit and latest visit instructions
+1 NEW X,TARGET,LINE,Y
+2 SET TARGET=$$TMPGBL
+3 SET X=$$VPIP^BJPNAPI(TARGET,DFN,"",1,"O")
+4 SET LINE=""
+5 FOR
SET LINE=$ORDER(^TMP("BHSOB",$JOB,LINE))
IF LINE=""
QUIT
Begin DoDot:1
+6 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+7 WRITE $GET(^TMP("BHSOB",$JOB,LINE,0)),!
End DoDot:1
+8 QUIT
VPOV ;Get All PIP problems used as a POV for the visit and associated visit instructions
+1 NEW X,TARGET,LINE,Y
+2 SET TARGET=$$TMPGBL
+3 SET X=$$VPOV^BJPNAPI(TARGET,DFN,"","O")
+4 SET LINE=""
+5 FOR
SET LINE=$ORDER(^TMP("BHSOB",$JOB,LINE))
IF LINE=""
QUIT
Begin DoDot:1
+6 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+7 WRITE $GET(^TMP("BHSOB",$JOB,LINE,0)),!
End DoDot:1
+8 QUIT
TMPGBL() ;EP
+1 KILL ^TMP("BHSOB",$JOB)
QUIT $NAME(^($JOB))
