- RABTCH1 ;HISC/CAH,FPT AISC/MJK,RMO-Batch Report Menu ;9/28/94 10:49
- ;;5.0;Radiology/Nuclear Medicine;**8,47**;Mar 16, 1998;Build 21
- VERIFY ;Verify Batch
- D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
- W ! S DIC("S")="I $P(^(0),U,4)",DIC("A")="Select Batch: ",DIC="^RABTCH(74.2,",DIC(0)="AEZMQ" D ^DIC K DIC G Q:Y<0 S RAPGM="NXT^RABTCH1",RABTCH=+Y,LINE="",$P(LINE,"-",80)=""
- W !!,"Batch: ",$P(Y(0),"^"),?30,"Date Created: " S Y=$P(Y(0),"^",2) D D^RAUTL W Y,?65,$S($D(^VA(200,+$P(Y(0),"^",3),0)):$E($P(^(0),"^"),1,14),1:"")
- S Y=$P(Y(0),"^",4) D D^RAUTL:Y]"" W !?30,"Last Printed: ",Y
- ASKVER R !!,"Is this the batch you want to verify? No// ",X:DTIME S:'$T!(X="")!(X["^") X="N" G Q:"Nn"[$E(X) I "Yy"'[$E(X) W:X'["?" *7 W !!,?3,"Enter 'YES' to verify this batch, or 'NO' not to." G ASKVER
- ; Get e-sig
- D ^RASIGU I %=0 G Q
- S RAVER=$P(^VA(200,RASIG("PER"),0),U,1)
- S RAONLINE=""
- ;
- W !,LINE F RAI=0:0 S RAI=$O(^RABTCH(74.2,RABTCH,"R",RAI)) Q:RAI'>0 I $D(^(RAI,0)) S (RARPT,Y)=+^(0) D RASET^RAUTL2 D CHK:+Y Q:$D(RAUP)!('$D(RACT))
- G:'$D(RACT) Q1
- ASKBAT R !!,"Can this batch now be deleted? No// ",X:DTIME S:'$T!(X="")!(X["^") X="N" G Q1:"Nn"[$E(X) I "Yy"'[$E(X) W:X'["?" *7 W !!?3,"Enter 'YES' to delete this batch, or 'NO' not to." G ASKBAT
- S DA=RABTCH,DIK="^RABTCH(74.2," D ^DIK W !?3,"...deletion complete."
- Q1 I '$D(RAUP),$D(^TMP($J,"RA","DT")) D UPSTATM^RAUTL0
- Q K %,%X,D,D0,D1,DA,DIC,DIK,DIE,DR,RA,RACT,RADATE,RAUP,RABTCH,LINE,RADFN,RADTE,RADTI,RACN,RACNI,RAOR,RARPT,RA0,RAI,RAPGM,RASN,RASTI,RAVER,^TMP($J,"RA")
- K %W,%X,%Y1,C,X,Y
- K DDH,DISYS,POP
- K RAVER,RAONLINE,RASIG
- Q
- ;
- CHK N RASSAN,RACNDSP S RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
- S RACNDSP=$S((RASSAN'=""):RASSAN,1:RACN)
- I $$USESSAN^RAHLRU1() I $P(^RARPT(RARPT,0),"^",5)="V" W !?3,"...report for case no. ",RACNDSP," is already verified" S RACT="" W !,LINE Q
- I $$USESSAN^RAHLRU1() W !,"Report for case no. ",RACNDSP," for ",$S($D(^DPT(RADFN,0)):$P(^(0),"^"),1:"UNKNOWN") G 31^RART
- I '$$USESSAN^RAHLRU1() I $P(^RARPT(RARPT,0),"^",5)="V" W !?3,"...report for case no. ",RACN," is already verified" S RACT="" W !,LINE Q
- I '$$USESSAN^RAHLRU1() W !,"Report for case no. ",RACN," for ",$S($D(^DPT(RADFN,0)):$P(^(0),"^"),1:"UNKNOWN") G 31^RART
- NXT I '$D(RACT) K RAAB Q
- W !,LINE I RACT="V" S ^TMP($J,"RA","DT",RADTE,RARPT)=$S($D(RAAB):1,1:"")
- K RAAB Q
- RABTCH1 ;HISC/CAH,FPT AISC/MJK,RMO-Batch Report Menu ;9/28/94 10:49
- +1 ;;5.0;Radiology/Nuclear Medicine;**8,47**;Mar 16, 1998;Build 21
- VERIFY ;Verify Batch
- +1 DO SET^RAPSET1
- IF $DATA(XQUIT)
- KILL XQUIT
- QUIT
- +2 WRITE !
- SET DIC("S")="I $P(^(0),U,4)"
- SET DIC("A")="Select Batch: "
- SET DIC="^RABTCH(74.2,"
- SET DIC(0)="AEZMQ"
- DO ^DIC
- KILL DIC
- IF Y<0
- GOTO Q
- SET RAPGM="NXT^RABTCH1"
- SET RABTCH=+Y
- SET LINE=""
- SET $PIECE(LINE,"-",80)=""
- +3 WRITE !!,"Batch: ",$PIECE(Y(0),"^"),?30,"Date Created: "
- SET Y=$PIECE(Y(0),"^",2)
- DO D^RAUTL
- WRITE Y,?65,$SELECT($DATA(^VA(200,+$PIECE(Y(0),"^",3),0)):$EXTRACT($PIECE(^(0),"^"),1,14),1:"")
- +4 SET Y=$PIECE(Y(0),"^",4)
- IF Y]""
- DO D^RAUTL
- WRITE !?30,"Last Printed: ",Y
- ASKVER READ !!,"Is this the batch you want to verify? No// ",X:DTIME
- IF '$TEST!(X="")!(X["^")
- SET X="N"
- IF "Nn"[$EXTRACT(X)
- GOTO Q
- IF "Yy"'[$EXTRACT(X)
- IF X'["?"
- WRITE *7
- WRITE !!,?3,"Enter 'YES' to verify this batch, or 'NO' not to."
- GOTO ASKVER
- +1 ; Get e-sig
- +2 DO ^RASIGU
- IF %=0
- GOTO Q
- +3 SET RAVER=$PIECE(^VA(200,RASIG("PER"),0),U,1)
- +4 SET RAONLINE=""
- +5 ;
- +6 WRITE !,LINE
- FOR RAI=0:0
- SET RAI=$ORDER(^RABTCH(74.2,RABTCH,"R",RAI))
- IF RAI'>0
- QUIT
- IF $DATA(^(RAI,0))
- SET (RARPT,Y)=+^(0)
- DO RASET^RAUTL2
- IF +Y
- DO CHK
- IF $DATA(RAUP)!('$DATA(RACT))
- QUIT
- +7 IF '$DATA(RACT)
- GOTO Q1
- ASKBAT READ !!,"Can this batch now be deleted? No// ",X:DTIME
- IF '$TEST!(X="")!(X["^")
- SET X="N"
- IF "Nn"[$EXTRACT(X)
- GOTO Q1
- IF "Yy"'[$EXTRACT(X)
- IF X'["?"
- WRITE *7
- WRITE !!?3,"Enter 'YES' to delete this batch, or 'NO' not to."
- GOTO ASKBAT
- +1 SET DA=RABTCH
- SET DIK="^RABTCH(74.2,"
- DO ^DIK
- WRITE !?3,"...deletion complete."
- Q1 IF '$DATA(RAUP)
- IF $DATA(^TMP($JOB,"RA","DT"))
- DO UPSTATM^RAUTL0
- Q KILL %,%X,D,D0,D1,DA,DIC,DIK,DIE,DR,RA,RACT,RADATE,RAUP,RABTCH,LINE,RADFN,RADTE,RADTI,RACN,RACNI,RAOR,RARPT,RA0,RAI,RAPGM,RASN,RASTI,RAVER,^TMP($JOB,"RA")
- +1 KILL %W,%X,%Y1,C,X,Y
- +2 KILL DDH,DISYS,POP
- +3 KILL RAVER,RAONLINE,RASIG
- +4 QUIT
- +5 ;
- CHK NEW RASSAN,RACNDSP
- SET RASSAN=$$SSANVAL^RAHLRU1(RADFN,RADTI,RACNI)
- +1 SET RACNDSP=$SELECT((RASSAN'=""):RASSAN,1:RACN)
- +2 IF $$USESSAN^RAHLRU1()
- IF $PIECE(^RARPT(RARPT,0),"^",5)="V"
- WRITE !?3,"...report for case no. ",RACNDSP," is already verified"
- SET RACT=""
- WRITE !,LINE
- QUIT
- +3 IF $$USESSAN^RAHLRU1()
- WRITE !,"Report for case no. ",RACNDSP," for ",$SELECT($DATA(^DPT(RADFN,0)):$PIECE(^(0),"^"),1:"UNKNOWN")
- GOTO 31^RART
- +4 IF '$$USESSAN^RAHLRU1()
- IF $PIECE(^RARPT(RARPT,0),"^",5)="V"
- WRITE !?3,"...report for case no. ",RACN," is already verified"
- SET RACT=""
- WRITE !,LINE
- QUIT
- +5 IF '$$USESSAN^RAHLRU1()
- WRITE !,"Report for case no. ",RACN," for ",$SELECT($DATA(^DPT(RADFN,0)):$PIECE(^(0),"^"),1:"UNKNOWN")
- GOTO 31^RART
- NXT IF '$DATA(RACT)
- KILL RAAB
- QUIT
- +1 WRITE !,LINE
- IF RACT="V"
- SET ^TMP($JOB,"RA","DT",RADTE,RARPT)=$SELECT($DATA(RAAB):1,1:"")
- +2 KILL RAAB
- QUIT
