GMTSPXXP ; SLC/SBW,KER,PKR - PCE Examination Comp ; 04/15/2022
;;2.7;Health Summary;**8,10,28,56,122,115**;Oct 20, 1995;Build 190
;
; External References
; DBIA 3063 EXAM^PXRHS05
; DBIA 10011 ^DIWP
;
MRE ; Most Recent Examination
K ^TMP("PXE",$J)
N MAX S MAX=1
;
; This routine could be expanded to included
; occurrence limits by setting max to GMTSNDM
; and enabling occurrence limit for the
; component. Component name would have to
; change also.
;
D EXAM^PXRHS05(DFN,GMTSEND,GMTSBEG,MAX) Q:'$D(^TMP("PXE",$J))
N COMMENT,EXAM,GMDT,GMEXAM,GMICL,GMIFN,GMN0,GMN1,GMSITE
N GMTAB,GMTSDATE,GMTSLN,RESULT,TEXT,X,WDATE
D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR
S GMDT=0
F S GMDT=+$O(^TMP("PXE",$J,GMDT)) Q:GMDT=0 D Q:$D(GMTSQIT)
. S GMEXAM="",WDATE=1
. F S GMEXAM=$O(^TMP("PXE",$J,GMDT,GMEXAM)) Q:GMEXAM="" D Q:$D(GMTSQIT)
.. S GMIFN=0
.. F S GMIFN=$O(^TMP("PXE",$J,GMDT,GMEXAM,GMIFN)) Q:GMIFN'>0 D EXAMDSP(WDATE) S WDATE=0 Q:$D(GMTSQIT)
K ^TMP("PXE",$J)
Q
;
HDR ; Header
W "Event/Visit",?12,"Facility",?25,"Exam - Result"
W !,?3,"Date",!!
Q
;
EXAMDSP(WDATE) ; Display Exam Data
S GMN0=$G(^TMP("PXE",$J,GMDT,GMEXAM,GMIFN,0)) Q:GMN0']""
S GMN1=$G(^TMP("PXE",$J,GMDT,GMEXAM,GMIFN,1))
S GMSITE=$S($P(GMN1,U,3)]"":$E($P(GMN1,U,3),1,10),$P(GMN1,U,4)]"":$E($P(GMN1,U,4),1,10),1:"No Site")
D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG HDR
S X=$P(GMN0,U,2) D REGDT4^GMTSU S GMTSDATE=X
S EXAM=$P(GMN0,U,1),RESULT=$P(GMN0,U,4)
I RESULT'="" S RESULT=" - "_RESULT
S TEXT=EXAM_RESULT
I (WDATE=1) W GMTSDATE
W ?12,GMSITE
I $L(TEXT)<56 W ?25,TEXT,!
E D LONGTEXT(TEXT)
I $G(^TMP("PXE",$J,GMDT,GMEXAM,GMIFN,"MEASUREMENT"))'="" D
. N MAGNITUDE,MEAS,UCUMDISPLAY,UCUMFIELD,UCUMIEN,UNITS
. S MEAS=^TMP("PXE",$J,GMDT,GMEXAM,GMIFN,"MEASUREMENT")
. S MAGNITUDE=$P(MEAS,U,1)
. I MAGNITUDE="" Q
. S UCUMIEN=$P(MEAS,U,2)
. I UCUMIEN'="" D
.. S UCUMDISPLAY=$P(MEAS,U,3)
.. I UCUMDISPLAY="N" S UNITS="" Q
.. S UCUMFIELD=$S(UCUMDISPLAY="C":"UCUM CODE",1:"DESCRIPTION")
.. S UNITS=$$UCUMFIELDS^GMTSUCUM(UCUMIEN,UCUMFIELD)
. E S UNITS=""
. I UNITS="" S TEXT=" Magnitude: "
. E S TEXT=" Measurement: "
. S TEXT=TEXT_MAGNITUDE
. I UNITS'="" S TEXT=TEXT_" "_UNITS
. I $L(TEXT)<56 W ?25,TEXT,!
. E D LONGTEXT(TEXT)
S COMMENT=$P($G(^TMP("PXE",$J,GMDT,GMEXAM,GMIFN,"COM")),U,1)
I COMMENT]"" S GMICL=26,GMTAB=2 D FORMAT I $D(^UTILITY($J,"W")) D
. F GMTSLN=1:1:^UTILITY($J,"W",DIWL) D LINE Q:$D(GMTSQIT)
Q
;
FORMAT ; Format Line
N DIWR,DIWF,X S DIWL=3,DIWR=80-(GMICL+GMTAB) K ^UTILITY($J,"W")
S X=COMMENT D ^DIWP
Q
;
LINE ; Write Line
D CKP^GMTSUP Q:$D(GMTSQIT) W ?26,^UTILITY($J,"W",DIWL,GMTSLN,0),!
Q
;
LONGTEXT(TEXT) ;
N BPT,IND
S BPT=55
F IND=55:-1 Q:(BPT<55)!(IND=1) I $E(TEXT,IND)=" " S BPT=IND
W ?25,$E(TEXT,1,BPT),!
W ?25,$E(TEXT,(BPT+1),$L(TEXT)),!
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSPXXP 2976 printed Dec 13, 2024@01:59:56 Page 2
GMTSPXXP ; SLC/SBW,KER,PKR - PCE Examination Comp ; 04/15/2022
+1 ;;2.7;Health Summary;**8,10,28,56,122,115**;Oct 20, 1995;Build 190
+2 ;
+3 ; External References
+4 ; DBIA 3063 EXAM^PXRHS05
+5 ; DBIA 10011 ^DIWP
+6 ;
MRE ; Most Recent Examination
+1 KILL ^TMP("PXE",$JOB)
+2 NEW MAX
SET MAX=1
+3 ;
+4 ; This routine could be expanded to included
+5 ; occurrence limits by setting max to GMTSNDM
+6 ; and enabling occurrence limit for the
+7 ; component. Component name would have to
+8 ; change also.
+9 ;
+10 DO EXAM^PXRHS05(DFN,GMTSEND,GMTSBEG,MAX)
if '$DATA(^TMP("PXE",$JOB))
QUIT
+11 NEW COMMENT,EXAM,GMDT,GMEXAM,GMICL,GMIFN,GMN0,GMN1,GMSITE
+12 NEW GMTAB,GMTSDATE,GMTSLN,RESULT,TEXT,X,WDATE
+13 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HDR
+14 SET GMDT=0
+15 FOR
SET GMDT=+$ORDER(^TMP("PXE",$JOB,GMDT))
if GMDT=0
QUIT
Begin DoDot:1
+16 SET GMEXAM=""
SET WDATE=1
+17 FOR
SET GMEXAM=$ORDER(^TMP("PXE",$JOB,GMDT,GMEXAM))
if GMEXAM=""
QUIT
Begin DoDot:2
+18 SET GMIFN=0
+19 FOR
SET GMIFN=$ORDER(^TMP("PXE",$JOB,GMDT,GMEXAM,GMIFN))
if GMIFN'>0
QUIT
DO EXAMDSP(WDATE)
SET WDATE=0
if $DATA(GMTSQIT)
QUIT
End DoDot:2
if $DATA(GMTSQIT)
QUIT
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+20 KILL ^TMP("PXE",$JOB)
+21 QUIT
+22 ;
HDR ; Header
+1 WRITE "Event/Visit",?12,"Facility",?25,"Exam - Result"
+2 WRITE !,?3,"Date",!!
+3 QUIT
+4 ;
EXAMDSP(WDATE) ; Display Exam Data
+1 SET GMN0=$GET(^TMP("PXE",$JOB,GMDT,GMEXAM,GMIFN,0))
if GMN0']""
QUIT
+2 SET GMN1=$GET(^TMP("PXE",$JOB,GMDT,GMEXAM,GMIFN,1))
+3 SET GMSITE=$SELECT($PIECE(GMN1,U,3)]"":$EXTRACT($PIECE(GMN1,U,3),1,10),$PIECE(GMN1,U,4)]"":$EXTRACT($PIECE(GMN1,U,4),1,10),1:"No Site")
+4 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
DO HDR
+5 SET X=$PIECE(GMN0,U,2)
DO REGDT4^GMTSU
SET GMTSDATE=X
+6 SET EXAM=$PIECE(GMN0,U,1)
SET RESULT=$PIECE(GMN0,U,4)
+7 IF RESULT'=""
SET RESULT=" - "_RESULT
+8 SET TEXT=EXAM_RESULT
+9 IF (WDATE=1)
WRITE GMTSDATE
+10 WRITE ?12,GMSITE
+11 IF $LENGTH(TEXT)<56
WRITE ?25,TEXT,!
+12 IF '$TEST
DO LONGTEXT(TEXT)
+13 IF $GET(^TMP("PXE",$JOB,GMDT,GMEXAM,GMIFN,"MEASUREMENT"))'=""
Begin DoDot:1
+14 NEW MAGNITUDE,MEAS,UCUMDISPLAY,UCUMFIELD,UCUMIEN,UNITS
+15 SET MEAS=^TMP("PXE",$JOB,GMDT,GMEXAM,GMIFN,"MEASUREMENT")
+16 SET MAGNITUDE=$PIECE(MEAS,U,1)
+17 IF MAGNITUDE=""
QUIT
+18 SET UCUMIEN=$PIECE(MEAS,U,2)
+19 IF UCUMIEN'=""
Begin DoDot:2
+20 SET UCUMDISPLAY=$PIECE(MEAS,U,3)
+21 IF UCUMDISPLAY="N"
SET UNITS=""
QUIT
+22 SET UCUMFIELD=$SELECT(UCUMDISPLAY="C":"UCUM CODE",1:"DESCRIPTION")
+23 SET UNITS=$$UCUMFIELDS^GMTSUCUM(UCUMIEN,UCUMFIELD)
End DoDot:2
+24 IF '$TEST
SET UNITS=""
+25 IF UNITS=""
SET TEXT=" Magnitude: "
+26 IF '$TEST
SET TEXT=" Measurement: "
+27 SET TEXT=TEXT_MAGNITUDE
+28 IF UNITS'=""
SET TEXT=TEXT_" "_UNITS
+29 IF $LENGTH(TEXT)<56
WRITE ?25,TEXT,!
+30 IF '$TEST
DO LONGTEXT(TEXT)
End DoDot:1
+31 SET COMMENT=$PIECE($GET(^TMP("PXE",$JOB,GMDT,GMEXAM,GMIFN,"COM")),U,1)
+32 IF COMMENT]""
SET GMICL=26
SET GMTAB=2
DO FORMAT
IF $DATA(^UTILITY($JOB,"W"))
Begin DoDot:1
+33 FOR GMTSLN=1:1:^UTILITY($JOB,"W",DIWL)
DO LINE
if $DATA(GMTSQIT)
QUIT
End DoDot:1
+34 QUIT
+35 ;
FORMAT ; Format Line
+1 NEW DIWR,DIWF,X
SET DIWL=3
SET DIWR=80-(GMICL+GMTAB)
KILL ^UTILITY($JOB,"W")
+2 SET X=COMMENT
DO ^DIWP
+3 QUIT
+4 ;
LINE ; Write Line
+1 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?26,^UTILITY($JOB,"W",DIWL,GMTSLN,0),!
+2 QUIT
+3 ;
LONGTEXT(TEXT) ;
+1 NEW BPT,IND
+2 SET BPT=55
+3 FOR IND=55:-1
if (BPT<55)!(IND=1)
QUIT
IF $EXTRACT(TEXT,IND)=" "
SET BPT=IND
+4 WRITE ?25,$EXTRACT(TEXT,1,BPT),!
+5 WRITE ?25,$EXTRACT(TEXT,(BPT+1),$LENGTH(TEXT)),!
+6 QUIT
+7 ;
