- DVBCADE2 ;ALB/GTS-557/THM-ADD C&P EXAMS TO REQUESTS, PART 2 ; 4/18/91 7:23 AM
- ;;2.7;AMIE;**1,12**;Apr 10, 1995
- ;
- EXMHD W @FF,?(IOM-$L(HD2)\2),HD2,!!,"Please select the exams for ",$P(PNAM,",",2,99)," ",$P(PNAM,",",1),!,"Use ? to see a list exams available for selection.",!!
- ;
- EXMSEL I $D(DVBCLCKD) Q
- S DIC("S")="I $P(^(0),U,5)'=""I""",DIC="^DVB(396.6,",DIC(0)="AEQM"
- S DIC("A")="Select EXAM: "
- K OUT D ^DIC S:$D(DTOUT) OUT=1 Q:$D(OUT)
- G:X=""!(X=U) EXMDIS ;Only out of EXMSEL
- I +Y<0 W " ??",*7 G EXMSEL
- S EXMDA=+Y,EXMNM=$P(^DVB(396.6,+Y,0),U,1)
- I $D(^TMP($J,"NEW",EXMNM)) W " Duplicate - ignored",!,*7 G EXMSEL
- I $D(^DVB(396.4,"APS",DFN,EXMDA,"O")) W *7," -- already ON FILE",! G EXMSEL
- I $D(^DVB(396.4,"APS",DFN,EXMDA,"X"))!($D(^DVB(396.4,"APS",DFN,EXMDA,"RX"))) W *7," -- Previously cancelled, addition allowable",!
- FMT ;drop into
- S EXCNT=EXCNT+1
- G:EXCNT=1 FMT1 ;Only out of FMT
- K OUT
- S FMT="F"
- ;
- ;** FMT1 drops into from FMT or jumps into from FMT+3
- FMT1 S ^TMP($J,"NEW",EXMNM)=+Y_U_$S(EXCNT=1:"F",1:FMT)_U_EXMDA K Y H 1 W @FF,!!! G EXMSEL ;1st exam is 'full'
- ;
- EXMDIS K %,%Y,DIE,DIC G:$D(DVBCLCKD) EXMSEL
- I '$D(^TMP($J,"NEW")) W !!,*7,"You have not selected any exams.",!,"Do you want to try again" S %=1 D YN^DICN K OUT S:%=2 OUT=1 Q:$D(OUT) G:%=1 EXMHD I $D(DTOUT) S OUT=1 Q
- I $D(%Y) I %Y["?" W !!,"Enter Y to select more exams or N to abort adding exams to this request.",!! G EXMDIS
- I $D(%),%'=1 S OUT=1 Q
- W @FF,!!,"You have selected:",!! S EXMNM=""
- F JY=0:1 S EXMNM=$O(^TMP($J,"NEW",EXMNM)) Q:EXMNM="" W ?5,EXMNM,!
- S DIR(0)="YA"
- S DIR("A")=$S(JY'>1:"Is this exam",1:"Are these exams")_" correct? "
- S DIR("B")="NO"
- D ^DIR
- K DIR
- I Y K Y G EXMLOG
- I $D(DIRUT) K Y,DIROUT S OUT=1 Q
- EXMOD ;drop into
- I Y=0 K DIC,DIR,Y S DIC(0)="AEQM",DIC("A")="Enter EXAM to delete: ",DIC="^DVB(396.6,",DIC("S")="I $D(^TMP($J,""NEW"",$P(^(0),U,1)))"
- ;
- EXMOD1 W @FF,!!! K OUT D ^DIC
- S:$D(DTOUT) OUT=1 Q:$D(OUT)
- G:X=""!(X=U) EXMASK ;Only out of EXMOD1
- S EXMNM=$P(^DVB(396.6,+Y,0),U,1)
- I +Y>0&($D(^TMP($J,"NEW",EXMNM))) K ^TMP($J,"NEW",EXMNM) W:$X>50!($X<10) ! W " Ok ..." S EXCNT=EXCNT-1 H 2 G EXMOD
- G EXMOD1
- ;
- EXMASK K DIC
- W @FF,!!,"Want to add more exams"
- S %=1 D YN^DICN G:%=1 EXMHD ;add exams
- I $D(DTOUT) S OUT=1 Q
- I $D(%Y),%Y["?" W !!,"Enter Y to add more exams or N to go on and log existing selections." D CONTMES^DVBCUTL4 G EXMASK
- G EXMDIS
- ;
- EXMLOG W !! S EXMNM="" K DR,OUT
- N DVBCLCKD
- F DVBCJ=0:0 S EXMNM=$O(^TMP($J,"NEW",EXMNM)) Q:EXMNM="" S X=$$EXAM^DVBCUTL4 S:X=0 DVBCLCKD=1 Q:$D(DVBCLCKD) D EXMLOG1^DVBCUTL4 Q:$D(OUT)
- I $D(DTOUT) S OUT=1 D ROLLBCK^DVBCUTL4
- Q:$D(OUT)
- W:$D(DVBCLCKD) !!," Another user adding exams now...try again later."
- R:$D(DVBCLCKD) !," PRESS [Return] TO CONTINUE...",DVBCCONT:DTIME
- I $D(DVBCLCKD) D ROLLBCK^DVBCUTL4 G EXMDIS
- I $P(^DVB(396.3,REQDA,0),U,2)'[DT S DR="23.3///NOW;23.4////"_DUZ,(DIC,DIE)="^DVB(396.3,",DA=REQDA D ^DIE ;no edit if requested today
- D ^DVBCBUL1 W !
- I '$D(OUT) S DIR("A")="Do you want to print worksheets ",DIR("A",1)="Worksheets should be sent to a printer.",DIR(0)="Y",DIR("?",1)="Enter Y to print worksheets for items just entered or",DIR("?")="N to skip." D ^DIR Q:Y=0!(Y=U)
- D ^DVBCADE1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCADE2 3273 printed Feb 18, 2025@23:09:45 Page 2
- DVBCADE2 ;ALB/GTS-557/THM-ADD C&P EXAMS TO REQUESTS, PART 2 ; 4/18/91 7:23 AM
- +1 ;;2.7;AMIE;**1,12**;Apr 10, 1995
- +2 ;
- EXMHD WRITE @FF,?(IOM-$LENGTH(HD2)\2),HD2,!!,"Please select the exams for ",$PIECE(PNAM,",",2,99)," ",$PIECE(PNAM,",",1),!,"Use ? to see a list exams available for selection.",!!
- +1 ;
- EXMSEL IF $DATA(DVBCLCKD)
- QUIT
- +1 SET DIC("S")="I $P(^(0),U,5)'=""I"""
- SET DIC="^DVB(396.6,"
- SET DIC(0)="AEQM"
- +2 SET DIC("A")="Select EXAM: "
- +3 KILL OUT
- DO ^DIC
- if $DATA(DTOUT)
- SET OUT=1
- if $DATA(OUT)
- QUIT
- +4 ;Only out of EXMSEL
- if X=""!(X=U)
- GOTO EXMDIS
- +5 IF +Y<0
- WRITE " ??",*7
- GOTO EXMSEL
- +6 SET EXMDA=+Y
- SET EXMNM=$PIECE(^DVB(396.6,+Y,0),U,1)
- +7 IF $DATA(^TMP($JOB,"NEW",EXMNM))
- WRITE " Duplicate - ignored",!,*7
- GOTO EXMSEL
- +8 IF $DATA(^DVB(396.4,"APS",DFN,EXMDA,"O"))
- WRITE *7," -- already ON FILE",!
- GOTO EXMSEL
- +9 IF $DATA(^DVB(396.4,"APS",DFN,EXMDA,"X"))!($DATA(^DVB(396.4,"APS",DFN,EXMDA,"RX")))
- WRITE *7," -- Previously cancelled, addition allowable",!
- FMT ;drop into
- +1 SET EXCNT=EXCNT+1
- +2 ;Only out of FMT
- if EXCNT=1
- GOTO FMT1
- +3 KILL OUT
- +4 SET FMT="F"
- +5 ;
- +6 ;** FMT1 drops into from FMT or jumps into from FMT+3
- FMT1 ;1st exam is 'full'
- SET ^TMP($JOB,"NEW",EXMNM)=+Y_U_$SELECT(EXCNT=1:"F",1:FMT)_U_EXMDA
- KILL Y
- HANG 1
- WRITE @FF,!!!
- GOTO EXMSEL
- +1 ;
- EXMDIS KILL %,%Y,DIE,DIC
- if $DATA(DVBCLCKD)
- GOTO EXMSEL
- +1 IF '$DATA(^TMP($JOB,"NEW"))
- WRITE !!,*7,"You have not selected any exams.",!,"Do you want to try again"
- SET %=1
- DO YN^DICN
- KILL OUT
- if %=2
- SET OUT=1
- if $DATA(OUT)
- QUIT
- if %=1
- GOTO EXMHD
- IF $DATA(DTOUT)
- SET OUT=1
- QUIT
- +2 IF $DATA(%Y)
- IF %Y["?"
- WRITE !!,"Enter Y to select more exams or N to abort adding exams to this request.",!!
- GOTO EXMDIS
- +3 IF $DATA(%)
- IF %'=1
- SET OUT=1
- QUIT
- +4 WRITE @FF,!!,"You have selected:",!!
- SET EXMNM=""
- +5 FOR JY=0:1
- SET EXMNM=$ORDER(^TMP($JOB,"NEW",EXMNM))
- if EXMNM=""
- QUIT
- WRITE ?5,EXMNM,!
- +6 SET DIR(0)="YA"
- +7 SET DIR("A")=$SELECT(JY'>1:"Is this exam",1:"Are these exams")_" correct? "
- +8 SET DIR("B")="NO"
- +9 DO ^DIR
- +10 KILL DIR
- +11 IF Y
- KILL Y
- GOTO EXMLOG
- +12 IF $DATA(DIRUT)
- KILL Y,DIROUT
- SET OUT=1
- QUIT
- EXMOD ;drop into
- +1 IF Y=0
- KILL DIC,DIR,Y
- SET DIC(0)="AEQM"
- SET DIC("A")="Enter EXAM to delete: "
- SET DIC="^DVB(396.6,"
- SET DIC("S")="I $D(^TMP($J,""NEW"",$P(^(0),U,1)))"
- +2 ;
- EXMOD1 WRITE @FF,!!!
- KILL OUT
- DO ^DIC
- +1 if $DATA(DTOUT)
- SET OUT=1
- if $DATA(OUT)
- QUIT
- +2 ;Only out of EXMOD1
- if X=""!(X=U)
- GOTO EXMASK
- +3 SET EXMNM=$PIECE(^DVB(396.6,+Y,0),U,1)
- +4 IF +Y>0&($DATA(^TMP($JOB,"NEW",EXMNM)))
- KILL ^TMP($JOB,"NEW",EXMNM)
- if $X>50!($X<10)
- WRITE !
- WRITE " Ok ..."
- SET EXCNT=EXCNT-1
- HANG 2
- GOTO EXMOD
- +5 GOTO EXMOD1
- +6 ;
- EXMASK KILL DIC
- +1 WRITE @FF,!!,"Want to add more exams"
- +2 ;add exams
- SET %=1
- DO YN^DICN
- if %=1
- GOTO EXMHD
- +3 IF $DATA(DTOUT)
- SET OUT=1
- QUIT
- +4 IF $DATA(%Y)
- IF %Y["?"
- WRITE !!,"Enter Y to add more exams or N to go on and log existing selections."
- DO CONTMES^DVBCUTL4
- GOTO EXMASK
- +5 GOTO EXMDIS
- +6 ;
- EXMLOG WRITE !!
- SET EXMNM=""
- KILL DR,OUT
- +1 NEW DVBCLCKD
- +2 FOR DVBCJ=0:0
- SET EXMNM=$ORDER(^TMP($JOB,"NEW",EXMNM))
- if EXMNM=""
- QUIT
- SET X=$$EXAM^DVBCUTL4
- if X=0
- SET DVBCLCKD=1
- if $DATA(DVBCLCKD)
- QUIT
- DO EXMLOG1^DVBCUTL4
- if $DATA(OUT)
- QUIT
- +3 IF $DATA(DTOUT)
- SET OUT=1
- DO ROLLBCK^DVBCUTL4
- +4 if $DATA(OUT)
- QUIT
- +5 if $DATA(DVBCLCKD)
- WRITE !!," Another user adding exams now...try again later."
- +6 if $DATA(DVBCLCKD)
- READ !," PRESS [Return] TO CONTINUE...",DVBCCONT:DTIME
- +7 IF $DATA(DVBCLCKD)
- DO ROLLBCK^DVBCUTL4
- GOTO EXMDIS
- +8 ;no edit if requested today
- IF $PIECE(^DVB(396.3,REQDA,0),U,2)'[DT
- SET DR="23.3///NOW;23.4////"_DUZ
- SET (DIC,DIE)="^DVB(396.3,"
- SET DA=REQDA
- DO ^DIE
- +9 DO ^DVBCBUL1
- WRITE !
- +10 IF '$DATA(OUT)
- SET DIR("A")="Do you want to print worksheets "
- SET DIR("A",1)="Worksheets should be sent to a printer."
- SET DIR(0)="Y"
- SET DIR("?",1)="Enter Y to print worksheets for items just entered or"
- SET DIR("?")="N to skip."
- DO ^DIR
- if Y=0!(Y=U)
- QUIT
- +11 DO ^DVBCADE1
- +12 QUIT