- 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
- GMTSAMIE ; SLC/KER - Comp and Pension Exams ; 02/27/2002
- +1 ;;2.7;Health Summary;**28,49**;Oct 20, 1995
- +2 ;
- +3 ; External References
- +4 ; DBIA 1138 HSCP^DVBCHS0
- +5 ; DBIA 10011 ^DIWP
- +6 ; DBIA 10029 ^DIWW
- +7 ;
- MAIN ; Control branching
- +1 NEW GMDATE,GMEXAM,GMCNT,GMTSREC,DIWL,DIWR,DIWF,NODE,LINE,MAX
- +2 SET DIWL=1
- SET DIWR=80
- SET DIWF="W"
- KILL ^TMP("DVBC",$JOB)
- +3 DO HSCP^DVBCHS0(DFN,GMTS2,GMTS1,2)
- IF '$DATA(^TMP("DVBC",$JOB))
- QUIT
- +4 SET (GMDATE,GMCNT)=0
- SET MAX=$SELECT(+($GET(GMTSNDM))>0:+($GET(GMTSNDM)),1:999)
- +5 FOR
- SET GMDATE=$ORDER(^TMP("DVBC",$JOB,GMDATE))
- IF +GMDATE'>0!(GMCNT'<MAX)
- QUIT
- Begin DoDot:1
- +6 SET GMEXAM=""
- +7 FOR
- SET GMEXAM=$ORDER(^TMP("DVBC",$JOB,GMDATE,GMEXAM))
- IF GMEXAM']""!(GMCNT'<MAX)
- QUIT
- DO WRT
- End DoDot:1
- +8 KILL ^TMP("DVBC",$JOB)
- +9 QUIT
- WRT ; Writes exam data
- +1 SET GMCNT=GMCNT+1
- +2 NEW EXAM,PRI,PHY,EXAMDATE,X
- +3 SET NODE=$GET(^TMP("DVBC",$JOB,GMDATE,GMEXAM,0))
- +4 SET X=$PIECE(NODE,U,2)
- DO REGDT4^GMTSU
- SET EXAMDATE=X
- +5 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE EXAMDATE,?15,$PIECE(NODE,U,3),!
- +6 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE ?3,"Priority of Exam: ",$EXTRACT($PIECE(NODE,U,5),1,20),!
- +7 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE ?1,"Examining provider: ",$PIECE(NODE,U,4),!
- +8 SET NODE=$GET(^TMP("DVBC",$JOB,GMDATE,GMEXAM,2))
- +9 SET X=$PIECE(NODE,U,3)
- DO REGDT4^GMTSU
- +10 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- +11 WRITE ?8,"Approved By: ",$PIECE(NODE,U,2)," on ",X,!
- +12 KILL ^UTILITY($JOB,"W")
- +13 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE "Examination results: ",!
- +14 SET LINE=0
- +15 FOR
- SET LINE=$ORDER(^TMP("DVBC",$JOB,GMDATE,GMEXAM,"RES",LINE))
- IF 'LINE
- QUIT
- SET X=^(LINE)
- DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- DO ^DIWP
- +16 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- DO ^DIWW
- +17 IF +$ORDER(^TMP("DVBC",$JOB,GMDATE,GMEXAM))!+$ORDER(^TMP("DVBC",$JOB,GMDATE))
- Begin DoDot:1
- +18 DO CKP^GMTSUP
- IF $DATA(GMTSQIT)
- QUIT
- WRITE !
- End DoDot:1
- +19 QUIT
