GMTSAMIE.m

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