source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSAMIE.m@ 1006

Last change on this file since 1006 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1GMTSAMIE ; 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 ;
9MAIN ; 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
19WRT ; 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
Note: See TracBrowser for help on using the repository browser.