GMTSMHPE ; SLC/JER,KER - Mental Health Physical Exam Component ; 11/14/2011
;;2.7;Health Summary;**49,102**;Oct 20, 1995;Build 25
;
; External References
; DBIA 1280 ^MR( (file #90)
; DBIA 10015 EN^DIQ1 (file #90)
;
MAIN ; Main control
Q
N GMCKC,GMDATA,GMDATE,GMEND,GMTSE,GMTSB,GMFLD,GMI,GMIL,GMTIMES,GMX,MAX Q:'$G(DFN) Q:'$D(^MR(+DFN,"PE"))
S GMTSB=$G(GMTS1) S:GMTSB'?7N GMTSB=6666666 S GMTSE=$G(GMTS2) S:GMTSE'?7N GMTSE=9999999
S MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:99999)
S GMTIMES=0
PHYEXAM ; Check for existence of PHYSICAL EXAM data
Q
S GMEND=GMTSE S GMDATE=GMTSB-.1
F S GMDATE=$O(^MR(+DFN,"PE",GMDATE)) Q:GMDATE']""!(GMDATE>GMEND) D Q:$D(GMTSQIT)!(MAX'>GMTIMES)
. N DIC,DIQ,DA,DR
. K ^UTILITY("DIQ1",$J)
. S DIC="^MR(",DA=+DFN,DR=100,DIQ(0)="EN"
. S DR(90.01)=".01:34",DA(90.01)=+GMDATE,DR(90.02)=.01,DA(90.02)=0
. S DR(90.03)=.01,DA(90.03)=0
. D EN^DIQ1
. Q:'$D(^UTILITY("DIQ1",$J))
. S GMTIMES=GMTIMES+1
. D VS(+DFN,+GMDATE) Q:$D(GMTSQIT)
. D OMITABN
. D SHOWOMIT Q:$D(GMTSQIT)
. D SHOWABN Q:$D(GMTSQIT)
. W !
K ^UTILITY("DIQ1",$J)
Q
;
VS(DFN,GMDATE) ; Show vital signs
N GMI,GMTXT D CKP^GMTSUP Q:$D(GMTSQIT)
W "VITAL SIGNS DATE: ",$S($G(^UTILITY("DIQ1",$J,90.01,+GMDATE,.01,"E"))]"":^("E"),1:"Unknown")
W ?40,"Examiner: ",$S($G(^UTILITY("DIQ1",$J,90.01,+GMDATE,29,"E"))]"":^("E"),1:"Unknown")
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,"Temp: ",$S($G(^UTILITY("DIQ1",$J,90.01,+GMDATE,.04,"E")):^("E")_"F",$G(^UTILITY("DIQ1",$J,90.01,+GMDATE,34,"E")):^("E")_"C",1:"")
W ?14,"Pulse: ",$G(^UTILITY("DIQ1",$J,90.01,+GMDATE,.05,"E"))
W ?28,"Resp: ",$G(^UTILITY("DIQ1",$J,90.01,+GMDATE,.07,"E"))
W ?42,"BP: ",$G(^UTILITY("DIQ1",$J,90.01,+GMDATE,.06,"E"))
W ?56,"Ht: ",$S($G(^UTILITY("DIQ1",$J,90.01,+GMDATE,.02,"E")):^("E")_"in",$G(^UTILITY("DIQ1",$J,90.01,+GMDATE,32,"E")):^("E")_"cm",1:"")
W ?70,"Wt: ",$S($G(^UTILITY("DIQ1",$J,90.01,+GMDATE,.03,"E")):^("E")_"lb",$G(^UTILITY("DIQ1",$J,90.01,+GMDATE,33,"E")):^("E")_"kg",1:""),!!
I +$O(^MR(+DFN,"PE",+GMDATE,19,0)) D Q:$D(GMTSQIT) W !
. W "Comments:",!
. S GMI=0 F S GMI=$O(^MR(+DFN,"PE",+GMDATE,19,GMI)) Q:GMI'>0 D Q:$D(GMTSQIT)
. . D CKP^GMTSUP Q:$D(GMTSQIT) W ?4,$G(^MR(+DFN,"PE",+GMDATE,19,GMI,0)),!
I +$O(^MR(+DFN,"PE",+GMDATE,20,0)) D Q:$D(GMTSQIT) W !
. W "Initial Impression:",! S GMI=0
. F S GMI=$O(^MR(+DFN,"PE",+GMDATE,20,GMI)) Q:GMI'>0 D Q:$D(GMTSQIT)
. . D CKP^GMTSUP Q:$D(GMTSQIT) W ?4,$G(^MR(+DFN,"PE",+GMDATE,20,GMI,0)),!
S GMTXT=$G(^UTILITY("DIQ1",$J,90.01,+GMDATE,.9,"E")) Q:GMTXT']""
D CKP^GMTSUP Q:$D(GMTSQIT) W "General Appearance: "
I $L(GMTXT)>59 S GMTXT=$$WRAP^GMTSORC(GMTXT,60)
F GMI=1:1:$L(GMTXT,"|") D CKP^GMTSUP Q:$D(GMTSQIT) W:$P(GMTXT,"|",GMI)]"" ?20,$P(GMTXT,"|",GMI),!
W !
Q
OMITABN ; Get PHYSICAL EXAM 'Omits' and 'Abnormals'
N GMFLD,GMX K GMDATA F GMFLD=2:1:19 D
. S GMX=$E($G(^UTILITY("DIQ1",$J,90.01,+GMDATE,+GMFLD,"E")))
. Q:GMX'?1U I GMX="O" S GMDATA("OM",+GMFLD)=$$SYS(+GMFLD)
. I GMX="A" S GMDATA("AB",+GMFLD)=$$SYS(+GMFLD)_"^"_$G(^UTILITY("DIQ1",$J,90.01,+GMDATE,+GMFLD_.9,"E"))
Q
;
SHOWOMIT ; Show 'Omits'
N GMYST,GMPHY D CKP^GMTSUP Q:$D(GMTSQIT) W "Omissions: "
I '$D(GMDATA("OM")) W " None",!! Q
S GMYST=0 F S GMYST=$O(GMDATA("OM",GMYST)) Q:GMYST'>0 D Q:$D(GMTSQIT)
. S GMPHY=GMDATA("OM",GMYST) I (($L(GMPHY)+$X)>(IOM-2)) D CKP^GMTSUP Q:$D(GMTSQIT) W !?11
. W GMPHY W:+$O(GMDATA("OM",GMYST)) ", "
D CKP^GMTSUP Q:$D(GMTSQIT) W !!
Q
;
SHOWABN ; Show 'Abnormals'
N GMI,GMTXT,GMYST,GMPHY D CKP^GMTSUP Q:$D(GMTSQIT) W "Abnormal Findings: "
I '$D(GMDATA("AB")) W " None",!! Q
W ! S GMYST=0 F S GMYST=$O(GMDATA("AB",GMYST)) Q:GMYST'>0 D Q:$D(GMTSQIT)
. S GMPHY=$P(GMDATA("AB",GMYST),"^",1) Q:GMPHY']""
. D CKP^GMTSUP Q:$D(GMTSQIT) W:GMTSNPG " Abnormal Findings (cont'd):",! W ?(17-$L(GMPHY)),GMPHY,":"
. S GMTXT=$P(GMDATA("AB",GMYST),"^",2) Q:GMTXT']""
. I $L(GMTXT)>60 S GMTXT=$$WRAP^GMTSORC(GMTXT,60)
. F GMI=1:1:$L(GMTXT,"|") D CKP^GMTSUP Q:$D(GMTSQIT) W:$P(GMTXT,"|",GMI)]"" ?19,$P(GMTXT,"|",GMI),!
W !
Q
;
SYS(GMHSYST) ; Physical System
S GMHSYST=$P("^Head^Eyes^Ears^Nose^Mouth^Neck^Chest&Breasts^Lungs^Heart^Abdomen^Genitalia^Pelvic^Rectum^Back^Extremities^Neurological^Skin^Lymph",U,GMHSYST)
Q GMHSYST
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSMHPE 4352 printed Sep 23, 2025@19:34:16 Page 2
GMTSMHPE ; SLC/JER,KER - Mental Health Physical Exam Component ; 11/14/2011
+1 ;;2.7;Health Summary;**49,102**;Oct 20, 1995;Build 25
+2 ;
+3 ; External References
+4 ; DBIA 1280 ^MR( (file #90)
+5 ; DBIA 10015 EN^DIQ1 (file #90)
+6 ;
MAIN ; Main control
+1 QUIT
+2 NEW GMCKC,GMDATA,GMDATE,GMEND,GMTSE,GMTSB,GMFLD,GMI,GMIL,GMTIMES,GMX,MAX
if '$GET(DFN)
QUIT
if '$DATA(^MR(+DFN,"PE"))
QUIT
+3 SET GMTSB=$GET(GMTS1)
if GMTSB'?7N
SET GMTSB=6666666
SET GMTSE=$GET(GMTS2)
if GMTSE'?7N
SET GMTSE=9999999
+4 SET MAX=$SELECT(+($GET(GMTSNDM))>0:+($GET(GMTSNDM)),1:99999)
+5 SET GMTIMES=0
PHYEXAM ; Check for existence of PHYSICAL EXAM data
+1 QUIT
+2 SET GMEND=GMTSE
SET GMDATE=GMTSB-.1
+3 FOR
SET GMDATE=$ORDER(^MR(+DFN,"PE",GMDATE))
if GMDATE']""!(GMDATE>GMEND)
QUIT
Begin DoDot:1
+4 NEW DIC,DIQ,DA,DR
+5 KILL ^UTILITY("DIQ1",$JOB)
+6 SET DIC="^MR("
SET DA=+DFN
SET DR=100
SET DIQ(0)="EN"
+7 SET DR(90.01)=".01:34"
SET DA(90.01)=+GMDATE
SET DR(90.02)=.01
SET DA(90.02)=0
+8 SET DR(90.03)=.01
SET DA(90.03)=0
+9 DO EN^DIQ1
+10 if '$DATA(^UTILITY("DIQ1",$JOB))
QUIT
+11 SET GMTIMES=GMTIMES+1
+12 DO VS(+DFN,+GMDATE)
if $DATA(GMTSQIT)
QUIT
+13 DO OMITABN
+14 DO SHOWOMIT
if $DATA(GMTSQIT)
QUIT
+15 DO SHOWABN
if $DATA(GMTSQIT)
QUIT
+16 WRITE !
End DoDot:1
if $DATA(GMTSQIT)!(MAX'>GMTIMES)
QUIT
+17 KILL ^UTILITY("DIQ1",$JOB)
+18 QUIT
+19 ;
VS(DFN,GMDATE) ; Show vital signs
+1 NEW GMI,GMTXT
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+2 WRITE "VITAL SIGNS DATE: ",$SELECT($GET(^UTILITY("DIQ1",$JOB,90.01,+GMDATE,.01,"E"))]"":^("E"),1:"Unknown")
+3 WRITE ?40,"Examiner: ",$SELECT($GET(^UTILITY("DIQ1",$JOB,90.01,+GMDATE,29,"E"))]"":^("E"),1:"Unknown")
+4 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+5 WRITE !,"Temp: ",$SELECT($GET(^UTILITY("DIQ1",$JOB,90.01,+GMDATE,.04,"E")):^("E")_"F",$GET(^UTILITY("DIQ1",$JOB,90.01,+GMDATE,34,"E")):^("E")_"C",1:"")
+6 WRITE ?14,"Pulse: ",$GET(^UTILITY("DIQ1",$JOB,90.01,+GMDATE,.05,"E"))
+7 WRITE ?28,"Resp: ",$GET(^UTILITY("DIQ1",$JOB,90.01,+GMDATE,.07,"E"))
+8 WRITE ?42,"BP: ",$GET(^UTILITY("DIQ1",$JOB,90.01,+GMDATE,.06,"E"))
+9 WRITE ?56,"Ht: ",$SELECT($GET(^UTILITY("DIQ1",$JOB,90.01,+GMDATE,.02,"E")):^("E")_"in",$GET(^UTILITY("DIQ1",$JOB,90.01,+GMDATE,32,"E")):^("E")_"cm",1:"")
+10 WRITE ?70,"Wt: ",$SELECT($GET(^UTILITY("DIQ1",$JOB,90.01,+GMDATE,.03,"E")):^("E")_"lb",$GET(^UTILITY("DIQ1",$JOB,90.01,+GMDATE,33,"E")):^("E")_"kg",1:""),!!
+11 IF +$ORDER(^MR(+DFN,"PE",+GMDATE,19,0))
Begin DoDot:1
+12 WRITE "Comments:",!
+13 SET GMI=0
FOR
SET GMI=$ORDER(^MR(+DFN,"PE",+GMDATE,19,GMI))
if GMI'>0
QUIT
Begin DoDot:2
+14 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?4,$GET(^MR(+DFN,"PE",+GMDATE,19,GMI,0)),!
End DoDot:2
if $DATA(GMTSQIT)
QUIT
End DoDot:1
if $DATA(GMTSQIT)
QUIT
WRITE !
+15 IF +$ORDER(^MR(+DFN,"PE",+GMDATE,20,0))
Begin DoDot:1
+16 WRITE "Initial Impression:",!
SET GMI=0
+17 FOR
SET GMI=$ORDER(^MR(+DFN,"PE",+GMDATE,20,GMI))
if GMI'>0
QUIT
Begin DoDot:2
+18 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?4,$GET(^MR(+DFN,"PE",+GMDATE,20,GMI,0)),!
End DoDot:2
if $DATA(GMTSQIT)
QUIT
End DoDot:1
if $DATA(GMTSQIT)
QUIT
WRITE !
+19 SET GMTXT=$GET(^UTILITY("DIQ1",$JOB,90.01,+GMDATE,.9,"E"))
if GMTXT']""
QUIT
+20 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE "General Appearance: "
+21 IF $LENGTH(GMTXT)>59
SET GMTXT=$$WRAP^GMTSORC(GMTXT,60)
+22 FOR GMI=1:1:$LENGTH(GMTXT,"|")
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if $PIECE(GMTXT,"|",GMI)]""
WRITE ?20,$PIECE(GMTXT,"|",GMI),!
+23 WRITE !
+24 QUIT
OMITABN ; Get PHYSICAL EXAM 'Omits' and 'Abnormals'
+1 NEW GMFLD,GMX
KILL GMDATA
FOR GMFLD=2:1:19
Begin DoDot:1
+2 SET GMX=$EXTRACT($GET(^UTILITY("DIQ1",$JOB,90.01,+GMDATE,+GMFLD,"E")))
+3 if GMX'?1U
QUIT
IF GMX="O"
SET GMDATA("OM",+GMFLD)=$$SYS(+GMFLD)
+4 IF GMX="A"
SET GMDATA("AB",+GMFLD)=$$SYS(+GMFLD)_"^"_$GET(^UTILITY("DIQ1",$JOB,90.01,+GMDATE,+GMFLD_.9,"E"))
End DoDot:1
+5 QUIT
+6 ;
SHOWOMIT ; Show 'Omits'
+1 NEW GMYST,GMPHY
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE "Omissions: "
+2 IF '$DATA(GMDATA("OM"))
WRITE " None",!!
QUIT
+3 SET GMYST=0
FOR
SET GMYST=$ORDER(GMDATA("OM",GMYST))
if GMYST'>0
QUIT
Begin DoDot:1
+4 SET GMPHY=GMDATA("OM",GMYST)
IF (($LENGTH(GMPHY)+$X)>(IOM-2))
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE !?11
+5 WRITE GMPHY
if +$ORDER(GMDATA("OM",GMYST))
WRITE ", "
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+6 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE !!
+7 QUIT
+8 ;
SHOWABN ; Show 'Abnormals'
+1 NEW GMI,GMTXT,GMYST,GMPHY
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE "Abnormal Findings: "
+2 IF '$DATA(GMDATA("AB"))
WRITE " None",!!
QUIT
+3 WRITE !
SET GMYST=0
FOR
SET GMYST=$ORDER(GMDATA("AB",GMYST))
if GMYST'>0
QUIT
Begin DoDot:1
+4 SET GMPHY=$PIECE(GMDATA("AB",GMYST),"^",1)
if GMPHY']""
QUIT
+5 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if GMTSNPG
WRITE " Abnormal Findings (cont'd):",!
WRITE ?(17-$LENGTH(GMPHY)),GMPHY,":"
+6 SET GMTXT=$PIECE(GMDATA("AB",GMYST),"^",2)
if GMTXT']""
QUIT
+7 IF $LENGTH(GMTXT)>60
SET GMTXT=$$WRAP^GMTSORC(GMTXT,60)
+8 FOR GMI=1:1:$LENGTH(GMTXT,"|")
DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
if $PIECE(GMTXT,"|",GMI)]""
WRITE ?19,$PIECE(GMTXT,"|",GMI),!
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+9 WRITE !
+10 QUIT
+11 ;
SYS(GMHSYST) ; Physical System
+1 SET GMHSYST=$PIECE("^Head^Eyes^Ears^Nose^Mouth^Neck^Chest&Breasts^Lungs^Heart^Abdomen^Genitalia^Pelvic^Rectum^Back^Extremities^Neurological^Skin^Lymph",U,GMHSYST)
+2 QUIT GMHSYST
