| [613] | 1 | GMTSAMIE ; SLC/KER - Comp and Pension Exams ; 02/27/2002
|
|---|
| 2 | ;;2.7;Health Summary;**28,49**;Oct 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; External References
|
|---|
| 5 | ; DBIA 1138 HSCP^DVBCHS0
|
|---|
| 6 | ; DBIA 10011 ^DIWP
|
|---|
| 7 | ; DBIA 10029 ^DIWW
|
|---|
| 8 | ;
|
|---|
| 9 | MAIN ; Control branching
|
|---|
| 10 | N GMDATE,GMEXAM,GMCNT,GMTSREC,DIWL,DIWR,DIWF,NODE,LINE,MAX
|
|---|
| 11 | S DIWL=1,DIWR=80,DIWF="W" K ^TMP("DVBC",$J)
|
|---|
| 12 | D HSCP^DVBCHS0(DFN,GMTS2,GMTS1,2) Q:'$D(^TMP("DVBC",$J))
|
|---|
| 13 | S (GMDATE,GMCNT)=0,MAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:999)
|
|---|
| 14 | F S GMDATE=$O(^TMP("DVBC",$J,GMDATE)) Q:+GMDATE'>0!(GMCNT'<MAX) D
|
|---|
| 15 | . S GMEXAM=""
|
|---|
| 16 | . F S GMEXAM=$O(^TMP("DVBC",$J,GMDATE,GMEXAM)) Q:GMEXAM']""!(GMCNT'<MAX) D WRT
|
|---|
| 17 | K ^TMP("DVBC",$J)
|
|---|
| 18 | Q
|
|---|
| 19 | WRT ; Writes exam data
|
|---|
| 20 | S GMCNT=GMCNT+1
|
|---|
| 21 | N EXAM,PRI,PHY,EXAMDATE,X
|
|---|
| 22 | S NODE=$G(^TMP("DVBC",$J,GMDATE,GMEXAM,0))
|
|---|
| 23 | S X=$P(NODE,U,2) D REGDT4^GMTSU S EXAMDATE=X
|
|---|
| 24 | D CKP^GMTSUP Q:$D(GMTSQIT) W EXAMDATE,?15,$P(NODE,U,3),!
|
|---|
| 25 | D CKP^GMTSUP Q:$D(GMTSQIT) W ?3,"Priority of Exam: ",$E($P(NODE,U,5),1,20),!
|
|---|
| 26 | D CKP^GMTSUP Q:$D(GMTSQIT) W ?1,"Examining provider: ",$P(NODE,U,4),!
|
|---|
| 27 | S NODE=$G(^TMP("DVBC",$J,GMDATE,GMEXAM,2))
|
|---|
| 28 | S X=$P(NODE,U,3) D REGDT4^GMTSU
|
|---|
| 29 | D CKP^GMTSUP Q:$D(GMTSQIT)
|
|---|
| 30 | W ?8,"Approved By: ",$P(NODE,U,2)," on ",X,!
|
|---|
| 31 | K ^UTILITY($J,"W")
|
|---|
| 32 | D CKP^GMTSUP Q:$D(GMTSQIT) W "Examination results: ",!
|
|---|
| 33 | S LINE=0
|
|---|
| 34 | F S LINE=$O(^TMP("DVBC",$J,GMDATE,GMEXAM,"RES",LINE)) Q:'LINE S X=^(LINE) D CKP^GMTSUP Q:$D(GMTSQIT) D ^DIWP
|
|---|
| 35 | D CKP^GMTSUP Q:$D(GMTSQIT) D ^DIWW
|
|---|
| 36 | I +$O(^TMP("DVBC",$J,GMDATE,GMEXAM))!+$O(^TMP("DVBC",$J,GMDATE)) D
|
|---|
| 37 | . D CKP^GMTSUP Q:$D(GMTSQIT) W !
|
|---|
| 38 | Q
|
|---|
