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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSAMIE 1586 printed Sep 23, 2025@19:33:10 Page 2
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
