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