GMTSAMIE ; SLC/KER - Comp and Pension Exams ; 02/27/2002
 ;;2.7;Health Summary;**28,49**;Oct 20, 1995
 ;                   
 ; External References
 ;   DBIA  1138  HSCP^DVBCHS0
 ;   DBIA 10011  ^DIWP
 ;   DBIA 10029  ^DIWW
 ;                   
MAIN ; Control branching
 N GMDATE,GMEXAM,GMCNT,GMTSREC,DIWL,DIWR,DIWF,NODE,LINE,MAX
 S DIWL=1,DIWR=80,DIWF="W" K ^TMP("DVBC",$J)
 D HSCP^DVBCHS0(DFN,GMTS2,GMTS1,2) Q:'$D(^TMP("DVBC",$J))
 S (GMDATE,GMCNT)=0,MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:999)
 F  S GMDATE=$O(^TMP("DVBC",$J,GMDATE)) Q:+GMDATE'>0!(GMCNT'<MAX)  D
 . S GMEXAM=""
 . F  S GMEXAM=$O(^TMP("DVBC",$J,GMDATE,GMEXAM)) Q:GMEXAM']""!(GMCNT'<MAX)  D WRT
 K ^TMP("DVBC",$J)
 Q
WRT ; Writes exam data
 S GMCNT=GMCNT+1
 N EXAM,PRI,PHY,EXAMDATE,X
 S NODE=$G(^TMP("DVBC",$J,GMDATE,GMEXAM,0))
 S X=$P(NODE,U,2) D REGDT4^GMTSU S EXAMDATE=X
 D CKP^GMTSUP Q:$D(GMTSQIT)  W EXAMDATE,?15,$P(NODE,U,3),!
 D CKP^GMTSUP Q:$D(GMTSQIT)  W ?3,"Priority of Exam: ",$E($P(NODE,U,5),1,20),!
 D CKP^GMTSUP Q:$D(GMTSQIT)  W ?1,"Examining provider: ",$P(NODE,U,4),!
 S NODE=$G(^TMP("DVBC",$J,GMDATE,GMEXAM,2))
 S X=$P(NODE,U,3) D REGDT4^GMTSU
 D CKP^GMTSUP Q:$D(GMTSQIT)
 W ?8,"Approved By: ",$P(NODE,U,2)," on ",X,!
 K ^UTILITY($J,"W")
 D CKP^GMTSUP Q:$D(GMTSQIT)  W "Examination results: ",!
 S LINE=0
 F  S LINE=$O(^TMP("DVBC",$J,GMDATE,GMEXAM,"RES",LINE)) Q:'LINE  S X=^(LINE) D CKP^GMTSUP Q:$D(GMTSQIT)  D ^DIWP
 D CKP^GMTSUP Q:$D(GMTSQIT)  D ^DIWW
 I +$O(^TMP("DVBC",$J,GMDATE,GMEXAM))!+$O(^TMP("DVBC",$J,GMDATE)) D
 . D CKP^GMTSUP Q:$D(GMTSQIT)  W !
 Q