DVBCLMU2.m

DVBCLMU2 ;ALB/CMM TEXT FOR INITIAL/REEVALUATION ;12/30/93

 ;;2.7;AMIE;;Apr 10, 1995

 ;

 ;Display of initial and reevaluation exam descriptions

 ;

WINIT ;

 ;initial exam description displayed using ^DIWP

 ;

 K ^UTILITY($J,"W")

 N JJ,DIWF,DIWL,X

 W !!

 S JJ=0,DIWF="WN",DIWL=5

 F  Q:$O(^DVBP(396.91,3,"D",JJ))=""  D

 .S JJ=$O(^DVBP(396.91,3,"D",JJ))

 .S X=$P(^DVBP(396.91,3,"D",JJ,0),"^")

 .D ^DIWP

 D ^DIWW

 Q

WREE ;

 ;reevaluation exam description displayed using ^DIWP

 ;

 K ^UTILITY($J,"W")

 N JJ,DIWF,DIWL,X

 W !!

 S JJ=0,DIWF="WN",DIWL=5

 F  Q:$O(^DVBP(396.91,4,"D",JJ))=""  D

 .S JJ=$O(^DVBP(396.91,4,"D",JJ))

 .S X=$P(^DVBP(396.91,4,"D",JJ,0),"^")

 .D ^DIWP

 D ^DIWW

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DVBCLMU2   707     printed  Apr 09, 2024@20:52:19                                                                                                                                                                                                     Page 2

DVBCLMU2  ;ALB/CMM TEXT FOR INITIAL/REEVALUATION ;12/30/93

 +1       ;;2.7;AMIE;;Apr 10, 1995

 +2       ;

 +3       ;Display of initial and reevaluation exam descriptions

 +4       ;

WINIT     ;

 +1       ;initial exam description displayed using ^DIWP

 +2       ;

 +3        KILL ^UTILITY($JOB,"W")

 +4        NEW JJ,DIWF,DIWL,X

 +5        WRITE !!

 +6        SET JJ=0

           SET DIWF="WN"

           SET DIWL=5

 +7        FOR 

               if $ORDER(^DVBP(396.91,3,"D",JJ))=""

                   QUIT 

               Begin DoDot:1

 +8                SET JJ=$ORDER(^DVBP(396.91,3,"D",JJ))

 +9                SET X=$PIECE(^DVBP(396.91,3,"D",JJ,0),"^")

 +10               DO ^DIWP

               End DoDot:1

 +11       DO ^DIWW

 +12       QUIT 

WREE      ;

 +1       ;reevaluation exam description displayed using ^DIWP

 +2       ;

 +3        KILL ^UTILITY($JOB,"W")

 +4        NEW JJ,DIWF,DIWL,X

 +5        WRITE !!

 +6        SET JJ=0

           SET DIWF="WN"

           SET DIWL=5

 +7        FOR 

               if $ORDER(^DVBP(396.91,4,"D",JJ))=""

                   QUIT 

               Begin DoDot:1

 +8                SET JJ=$ORDER(^DVBP(396.91,4,"D",JJ))

 +9                SET X=$PIECE(^DVBP(396.91,4,"D",JJ,0),"^")

 +10               DO ^DIWP

               End DoDot:1

 +11       DO ^DIWW

 +12       QUIT