BHSPLOB ;IHS/MSC/MGH - Health Summary for V OB notes ;12-Jul-2016 17:35;MGH
;;1.0;HEALTH SUMMARY COMPONENTS;**14**;Mar 17,2006;Build 4
;===================================================================
OBDT ;DISPLAY V OB DATA SORTED BY DATE IN HEALTH SUMMARY
N X,LINE,NUM,PRIEN,PROB,VCNT,VSCNT
N INVDT,IEN,EDATE,SIGN,STAT,FOUND,SDATE,EIE,SIGNDT
;The default is the latest visit
I $G(GMTSNDM)="" S NUM=99
E S NUM=GMTSNDM
D CKP^GMTSUP Q:$D(GMTSQIT)
;Get last date entries for each date of OB notes
S VCNT=0,FOUND=0,SDATE="",VSCNT=0
S VIEN=$G(VIEN)
S PRIEN="" F S PRIEN=$O(^AUPNVOB("AE",DFN,PRIEN)) Q:'+PRIEN D
.S INVDT="" F S INVDT=$O(^AUPNVOB("AE",DFN,PRIEN,INVDT)) Q:'+INVDT D
..S IEN="" F S IEN=$O(^AUPNVOB("AE",DFN,PRIEN,INVDT,IEN)) Q:IEN="" D
...S EIE=$$GET1^DIQ(9000010.43,IEN,.06,"I")
...Q:EIE=1
...S STAT=$P($G(^AUPNPROB(PRIEN,0)),U,12)
...Q:STAT="D"
...S EDATE=9999999-INVDT
...S EDATE=$$FMTE^XLFDT($P(EDATE,".",1),5)
...S SIGNDT=$$GET1^DIQ(9000010.58,IEN,.05,"I")
...S SIGNDT=$$FMTE^XLFDT($P(SIGNDT,".",1),5)
...S SIGN=$$GET1^DIQ(9000010.43,IEN,.04,"E")
...S PROB=$$GET1^DIQ(9000011,PRIEN,.05)
...W !,"Date: "_EDATE_" Problem: "_PROB
...D TEXT2(IEN)
Q
OBPR ;DISPLAY V OB data SORTED BY PROBLEM IN HEALTH SUMMARY
N X,LINE,NUM,PRIEN,INVDT,IEN,EIE,STAT,OLDPRB,EDATE,SIGNDT,SIGN,PROB
;The default is the latest visit
I $G(GMTSNDM)="" S NUM=99
E S NUM=GMTSNDM
D CKP^GMTSUP Q:$D(GMTSQIT)
S PRIEN="" F S PRIEN=$O(^AUPNVOB("AE",DFN,PRIEN)) Q:'+PRIEN D
.S OLDPRB=""
.S INVDT="" F S INVDT=$O(^AUPNVOB("AE",DFN,PRIEN,INVDT)) Q:'+INVDT D
..S IEN="" F S IEN=$O(^AUPNVOB("AE",DFN,PRIEN,INVDT,IEN)) Q:IEN="" D
...S EIE=$$GET1^DIQ(9000010.43,IEN,.06,"I")
...Q:EIE=1
...S STAT=$P($G(^AUPNPROB(PRIEN,0)),U,12)
...Q:STAT="D"
...I OLDPRB="" D
....W !,"Problem: "_$$GET1^DIQ(9000011,PRIEN,.05)
....S OLDPRB=PRIEN
...S EDATE=9999999-INVDT
...S EDATE=$$FMTE^XLFDT($P(EDATE,".",1),5)
...S SIGNDT=$$GET1^DIQ(9000010.58,IEN,.05,"I")
...S SIGNDT=$$FMTE^XLFDT($P(SIGNDT,".",1),5)
...S SIGN=$$GET1^DIQ(9000010.43,IEN,.04,"E")
...S PROB=$$GET1^DIQ(9000010.43,IEN,.01)
...W !,"Date: "_EDATE
...D TEXT2(IEN)
Q
TEXT2(IEN) ;do the text
N TXTIEN,WRAP,TXT,PRNT2,PRNT
S (PRNT,PRNT2,WRAP)=""
S TXTIEN=0 F S TXTIEN=$O(^AUPNVOB(IEN,11,TXTIEN)) Q:'+TXTIEN D
.S TXT=$G(^AUPNVOB(IEN,11,TXTIEN,0))
.S PRNT=PRNT2_TXT S PRNT2=""
.I $L(PRNT)>500 S PRNT2=$E(PRNT,501,$L(PRNT))
.D WRAP^BTIUPV1(.WRAP,PRNT,70)
;Process each wrapped line
I $D(WRAP)>1 D PROC(.WRAP)
W !
Q
PROC(WRAP) ;Process the word wrap
N I,LINE
F I=1:1:WRAP D
.I I=WRAP D
..I $L(WRAP(I))<45 D
...S LINE=" "_$G(WRAP(I))_" ("_SIGNDT_" by "_SIGN_")"
...W !,LINE
..E D
...W !," "_$G(WRAP(I))
...W !," ("_SIGNDT_" by "_SIGN_")"
.E W !," "_$G(WRAP(I))
Q
TMPGBL() ;EP
K ^TMP("BHSPL",$J) Q $NA(^($J))
BHSPLOB ;IHS/MSC/MGH - Health Summary for V OB notes ;12-Jul-2016 17:35;MGH
+1 ;;1.0;HEALTH SUMMARY COMPONENTS;**14**;Mar 17,2006;Build 4
+2 ;===================================================================
OBDT ;DISPLAY V OB DATA SORTED BY DATE IN HEALTH SUMMARY
+1 NEW X,LINE,NUM,PRIEN,PROB,VCNT,VSCNT
+2 NEW INVDT,IEN,EDATE,SIGN,STAT,FOUND,SDATE,EIE,SIGNDT
+3 ;The default is the latest visit
+4 IF $GET(GMTSNDM)=""
SET NUM=99
+5 IF '$TEST
SET NUM=GMTSNDM
+6 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+7 ;Get last date entries for each date of OB notes
+8 SET VCNT=0
SET FOUND=0
SET SDATE=""
SET VSCNT=0
+9 SET VIEN=$GET(VIEN)
+10 SET PRIEN=""
FOR
SET PRIEN=$ORDER(^AUPNVOB("AE",DFN,PRIEN))
IF '+PRIEN
QUIT
Begin DoDot:1
+11 SET INVDT=""
FOR
SET INVDT=$ORDER(^AUPNVOB("AE",DFN,PRIEN,INVDT))
IF '+INVDT
QUIT
Begin DoDot:2
+12 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVOB("AE",DFN,PRIEN,INVDT,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+13 SET EIE=$$GET1^DIQ(9000010.43,IEN,.06,"I")
+14 IF EIE=1
QUIT
+15 SET STAT=$PIECE($GET(^AUPNPROB(PRIEN,0)),U,12)
+16 IF STAT="D"
QUIT
+17 SET EDATE=9999999-INVDT
+18 SET EDATE=$$FMTE^XLFDT($PIECE(EDATE,".",1),5)
+19 SET SIGNDT=$$GET1^DIQ(9000010.58,IEN,.05,"I")
+20 SET SIGNDT=$$FMTE^XLFDT($PIECE(SIGNDT,".",1),5)
+21 SET SIGN=$$GET1^DIQ(9000010.43,IEN,.04,"E")
+22 SET PROB=$$GET1^DIQ(9000011,PRIEN,.05)
+23 WRITE !,"Date: "_EDATE_" Problem: "_PROB
+24 DO TEXT2(IEN)
End DoDot:3
End DoDot:2
End DoDot:1
+25 QUIT
OBPR ;DISPLAY V OB data SORTED BY PROBLEM IN HEALTH SUMMARY
+1 NEW X,LINE,NUM,PRIEN,INVDT,IEN,EIE,STAT,OLDPRB,EDATE,SIGNDT,SIGN,PROB
+2 ;The default is the latest visit
+3 IF $GET(GMTSNDM)=""
SET NUM=99
+4 IF '$TEST
SET NUM=GMTSNDM
+5 DO CKP^GMTSUP
IF $DATA(GMTSQIT)
QUIT
+6 SET PRIEN=""
FOR
SET PRIEN=$ORDER(^AUPNVOB("AE",DFN,PRIEN))
IF '+PRIEN
QUIT
Begin DoDot:1
+7 SET OLDPRB=""
+8 SET INVDT=""
FOR
SET INVDT=$ORDER(^AUPNVOB("AE",DFN,PRIEN,INVDT))
IF '+INVDT
QUIT
Begin DoDot:2
+9 SET IEN=""
FOR
SET IEN=$ORDER(^AUPNVOB("AE",DFN,PRIEN,INVDT,IEN))
IF IEN=""
QUIT
Begin DoDot:3
+10 SET EIE=$$GET1^DIQ(9000010.43,IEN,.06,"I")
+11 IF EIE=1
QUIT
+12 SET STAT=$PIECE($GET(^AUPNPROB(PRIEN,0)),U,12)
+13 IF STAT="D"
QUIT
+14 IF OLDPRB=""
Begin DoDot:4
+15 WRITE !,"Problem: "_$$GET1^DIQ(9000011,PRIEN,.05)
+16 SET OLDPRB=PRIEN
End DoDot:4
+17 SET EDATE=9999999-INVDT
+18 SET EDATE=$$FMTE^XLFDT($PIECE(EDATE,".",1),5)
+19 SET SIGNDT=$$GET1^DIQ(9000010.58,IEN,.05,"I")
+20 SET SIGNDT=$$FMTE^XLFDT($PIECE(SIGNDT,".",1),5)
+21 SET SIGN=$$GET1^DIQ(9000010.43,IEN,.04,"E")
+22 SET PROB=$$GET1^DIQ(9000010.43,IEN,.01)
+23 WRITE !,"Date: "_EDATE
+24 DO TEXT2(IEN)
End DoDot:3
End DoDot:2
End DoDot:1
+25 QUIT
TEXT2(IEN) ;do the text
+1 NEW TXTIEN,WRAP,TXT,PRNT2,PRNT
+2 SET (PRNT,PRNT2,WRAP)=""
+3 SET TXTIEN=0
FOR
SET TXTIEN=$ORDER(^AUPNVOB(IEN,11,TXTIEN))
IF '+TXTIEN
QUIT
Begin DoDot:1
+4 SET TXT=$GET(^AUPNVOB(IEN,11,TXTIEN,0))
+5 SET PRNT=PRNT2_TXT
SET PRNT2=""
+6 IF $LENGTH(PRNT)>500
SET PRNT2=$EXTRACT(PRNT,501,$LENGTH(PRNT))
+7 DO WRAP^BTIUPV1(.WRAP,PRNT,70)
End DoDot:1
+8 ;Process each wrapped line
+9 IF $DATA(WRAP)>1
DO PROC(.WRAP)
+10 WRITE !
+11 QUIT
PROC(WRAP) ;Process the word wrap
+1 NEW I,LINE
+2 FOR I=1:1:WRAP
Begin DoDot:1
+3 IF I=WRAP
Begin DoDot:2
+4 IF $LENGTH(WRAP(I))<45
Begin DoDot:3
+5 SET LINE=" "_$GET(WRAP(I))_" ("_SIGNDT_" by "_SIGN_")"
+6 WRITE !,LINE
End DoDot:3
+7 IF '$TEST
Begin DoDot:3
+8 WRITE !," "_$GET(WRAP(I))
+9 WRITE !," ("_SIGNDT_" by "_SIGN_")"
End DoDot:3
End DoDot:2
+10 IF '$TEST
WRITE !," "_$GET(WRAP(I))
End DoDot:1
+11 QUIT
TMPGBL() ;EP
+1 KILL ^TMP("BHSPL",$JOB)
QUIT $NAME(^($JOB))
