- 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 ---[H[J[2J[HDVBCLMU2 707 printed Jan 18, 2025@02:45:55 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