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 Dec 13, 2024@01:44:41 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
