- GMTSMHPE ; SLC/JER,KER - Mental Health Physical Exam Component ; 02/27/2002
- ;;2.7;Health Summary;**49**;Oct 20, 1995
- ;
- ; External References
- ; DBIA 1280 ^MR( (file #90)
- ; DBIA 10015 EN^DIQ1 (file #90)
- ;
- MAIN ; Main control
- 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
- 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
- GMTSMHPE ; SLC/JER,KER - Mental Health Physical Exam Component ; 02/27/2002
- +1 ;;2.7;Health Summary;**49**;Oct 20, 1995
- +2 ;
- +3 ; External References
- +4 ; DBIA 1280 ^MR( (file #90)
- +5 ; DBIA 10015 EN^DIQ1 (file #90)
- +6 ;
- MAIN ; Main control
- +1 NEW GMCKC,GMDATA,GMDATE,GMEND,GMTSE,GMTSB,GMFLD,GMI,GMIL,GMTIMES,GMX,MAX
- IF '$GET(DFN)
- QUIT
- IF '$DATA(^MR(+DFN,"PE"))
- QUIT
- +2 SET GMTSB=$GET(GMTS1)
- IF GMTSB'?7N
- SET GMTSB=6666666
- SET GMTSE=$GET(GMTS2)
- IF GMTSE'?7N
- SET GMTSE=9999999
- +3 SET MAX=$SELECT(+($GET(GMTSNDM))>0:+($GET(GMTSNDM)),1:99999)
- +4 SET GMTIMES=0
- PHYEXAM ; Check for existence of PHYSICAL EXAM data
- +1 SET GMEND=GMTSE
- SET GMDATE=GMTSB-.1
- +2 FOR
- SET GMDATE=$ORDER(^MR(+DFN,"PE",GMDATE))
- IF GMDATE']""!(GMDATE>GMEND)
- QUIT
- Begin DoDot:1
- +3 NEW DIC,DIQ,DA,DR
- +4 KILL ^UTILITY("DIQ1",$JOB)
- +5 SET DIC="^MR("
- SET DA=+DFN
- SET DR=100
- SET DIQ(0)="EN"
- +6 SET DR(90.01)=".01:34"
- SET DA(90.01)=+GMDATE
- SET DR(90.02)=.01
- SET DA(90.02)=0
- +7 SET DR(90.03)=.01
- SET DA(90.03)=0
- +8 DO EN^DIQ1
- +9 IF '$DATA(^UTILITY("DIQ1",$JOB))
- QUIT
- +10 SET GMTIMES=GMTIMES+1
- +11 DO VS(+DFN,+GMDATE)
- IF $DATA(GMTSQIT)
- QUIT
- +12 DO OMITABN
- +13 DO SHOWOMIT
- IF $DATA(GMTSQIT)
- QUIT
- +14 DO SHOWABN
- IF $DATA(GMTSQIT)
- QUIT
- +15 WRITE !
- End DoDot:1
- IF $DATA(GMTSQIT)!(MAX'>GMTIMES)
- QUIT
- +16 KILL ^UTILITY("DIQ1",$JOB)
- +17 QUIT
- +18 ;
- 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
