DVBCEDIT ;ALB/GTS-557/THM-EDIT 2507 DATA ; 6/19/91 1:22 PM
;;2.7;AMIE;**7,193**;Apr 10, 1995;Build 84
I $D(DUZ)#2=0 W *7,!!,"You have no user number.",!! Q
;
EN D HOME^%ZIS K OUT S FF=IOF,HD="Veteran Selection",HD2="2507 Exam Data Entry"
;
LOOK S %DT(0)=-DT D KILL W @FF,!?(80-$L(HD)\2),HD,!?(80-$L(HD2)\2),HD2,!!! S DIC("W")="D DICW^DVBCUTIL" S DIC="^DVB(396.3,",DIC(0)="AEQM",DIC("A")="Select VETERAN: " D ^DIC G:X=""!(X=U) EXIT I +Y<0 W " ???" H 1 G LOOK
S STAT=$P(^DVB(396.3,+Y,0),U,18)
;AJF; Request Status Conversion
S STAT=$$RSTAT^DVBCUTL8(STAT)
I STAT="N" W *7,!!,"This request has not been reported to MAS and may not be transcribed.",!! H 3 G LOOK
S (REQDA,DA(1))=+Y D STATCHK^DVBCUTL4 H:$D(NCN) 2 G:$D(NCN) LOOK
S DFN=$P(Y,U,2),REQDT=$P(^DVB(396.3,REQDA,0),U,2),PNAM=$S($D(^DPT(DFN,0)):$P(^(0),U,1),1:"Unknown"),SSN=$S($D(^(0)):$P(^(0),U,9),1:"Not specified")
S CNUM=$S($D(^DPT(DFN,.31)):$P(^(.31),U,3),1:"Unknown") K DICW
F DA=0:0 S DA=$O(^DVB(396.4,"C",REQDA,DA)) Q:DA="" S EXAM=$P(^DVB(396.4,DA,0),U,3) S EXAM=$P(^DVB(396.6,EXAM,0),U,1),STAT=$P(^DVB(396.4,DA,0),U,4),^TMP($J,EXAM)=STAT_U_DA
;
DATA K NCN,QUE D HDR^DVBCUTIL
W !
S Y=$$EXSRH^DVBCUTL4("Select Exam: ","I $D(^DVB(396.4,""ARQ""_REQDA,+Y))")
G:$D(DTOUT) EXIT G:X=""!(X=U) LOOK
I +Y<0 W *7," ???" G DATA
S DVBCLCKD=$$XMLCK(+Y)
I +DVBCLCKD'=1 W !!,*7,"This exam is currently being edited. <RETURN> to continue." R DVBCTST:DTIME K DVBCTST G DATA
S (EXMDA,DA)=+Y,EXMNM=$P(^DVB(396.4,+Y,0),U,3)
S EXMNM=$P(^DVB(396.6,EXMNM,0),U,1)
S STAT=$P(^TMP($J,EXMNM),U,1)
D STATCHK^DVBCUTL4
I STAT="C",$P(^DVB(396.4,EXMDA,0),U,10)]"" W !,*7,"These exam results have been electronically signed.",!,"No editing is allowed!" D CONTMES^DVBCUTL4 S DVBCLCKD=$$XMUNLCK(EXMDA) G DATA
W:STAT="C" "But you may make changes until it is released.",!! H:STAT="C" 2 I $D(NCN)&("^X^RX^"[STAT) S DVBCLCKD=$$XMUNLCK(EXMDA) G DATA
I STAT="T" W *7,!!,"This exam has been transferred to another facility.",!! H 2 S DVBCLCKD=$$XMUNLCK(EXMDA) G DATA
K DR S (DIC,DIE)="^DVB(396.4,",DR="W @FF;70;W @FF,!!;.06R;.07R"
S DA=EXMDA D ^DIE,COMP^DVBCUTL4
S DVBCLCKD=$$XMUNLCK(EXMDA)
G:$D(OUT) EXIT S STAT1=$P(^DVB(396.4,EXMDA,0),U,4),$P(^TMP($J,EXMNM),U,1)=STAT1
S NFINAL=0
F EXMDA=0:0 S EXMDA=$O(^DVB(396.4,"C",REQDA,EXMDA)) Q:EXMDA="" S STAT=$P(^DVB(396.4,EXMDA,0),U,4) I STAT'="C"&(STAT'="X")&(STAT'="RX") S NFINAL=1
I NFINAL=0,$P(^DVB(396.3,REQDA,0),U,12)="" S XMB="DVBA C 2507 EXAM READY",XMB(1)=PNAM,XMB(2)=SSN,Y=REQDT X ^DD("DD") S XREQDT=Y,XMB(3)=XREQDT D ^XMB K XMB,XREQDT
;
;AJF;Request Status conversion
QUE K IO("Q"),%DT S QUE="N" I NFINAL=0 K DR S DIE="^DVB(396.3,",DA=REQDA,DR="11///NOW;17////8" D ^DIE S %DT(0)=-DT
;
QUE1 K IO("Q") W !!,"Do you want to print a review copy" S %=2 D YN^DICN G:$D(DTOUT) EXIT I %=1 S QUE="Y"
I $D(%Y),%Y["?" W !!,"Enter Y to print a copy of the results for review",!,"or N to continue editing.",!! H 2 G QUE1
I QUE="Y" S (DA(1),DA)=REQDA W !! S %ZIS="AEQ" D ^%ZIS K %ZIS I POP S QUE="N" K IO("Q")
I '$D(IO("Q")),QUE="Y" S EDPRT=1 U IO D ZTSK^DVBCPRN1 K EDPRT,AUTO,ULINE,EXMNM,XEXMNM,PGHD,DVBCSITE
I $D(IO("Q")) S ZTRTN="ZTSK^DVBCPRN1",ZTIO=ION,ZTDESC="2507 Review Report",ZTDTH=$H F I="DVBC*","DUZ*","DA*","REQDA","EXMNM" S ZTSAVE(I)=""
I $D(IO("Q")) D ^%ZTLOAD I $D(ZTSK) W !!,"2507 Request queued for review to device "_ION,!! H 2 K ZTRTN,ZTIO,ZTSAVE,ZTDTH,ZTSK,IO("Q")
D ^%ZISC
I QUE="Y" G LOOK
G DATA
;
EXIT K DVBCLCKD D:$D(ZTQUEUED) KILL^%ZTLOAD K WPTYPE,%DT G KILL^DVBCUTIL
;
KILL K ^TMP($J),DIC,DA,D0,D1,DFN,X,Y,OLDEXAM,REQDT,DR,EXMNM,NCN,STAT,NOFND,NFINAL,QUE,%,%Y,%ZIS,IOP
Q
;
XMLCK(DA) ; ** Lock the 396.4 exam record selected for transcription **
L +^DVB(396.4,+DA,0):1
Q $T
;
XMUNLCK(DA) ; ** Unlock the 396.4 exam record selected for transcription **
L -^DVB(396.4,DA,0)
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCEDIT 3886 printed Dec 13, 2024@01:43:58 Page 2
DVBCEDIT ;ALB/GTS-557/THM-EDIT 2507 DATA ; 6/19/91 1:22 PM
+1 ;;2.7;AMIE;**7,193**;Apr 10, 1995;Build 84
+2 IF $DATA(DUZ)#2=0
WRITE *7,!!,"You have no user number.",!!
QUIT
+3 ;
EN DO HOME^%ZIS
KILL OUT
SET FF=IOF
SET HD="Veteran Selection"
SET HD2="2507 Exam Data Entry"
+1 ;
LOOK SET %DT(0)=-DT
DO KILL
WRITE @FF,!?(80-$LENGTH(HD)\2),HD,!?(80-$LENGTH(HD2)\2),HD2,!!!
SET DIC("W")="D DICW^DVBCUTIL"
SET DIC="^DVB(396.3,"
SET DIC(0)="AEQM"
SET DIC("A")="Select VETERAN: "
DO ^DIC
if X=""!(X=U)
GOTO EXIT
IF +Y<0
WRITE " ???"
HANG 1
GOTO LOOK
+1 SET STAT=$PIECE(^DVB(396.3,+Y,0),U,18)
+2 ;AJF; Request Status Conversion
+3 SET STAT=$$RSTAT^DVBCUTL8(STAT)
+4 IF STAT="N"
WRITE *7,!!,"This request has not been reported to MAS and may not be transcribed.",!!
HANG 3
GOTO LOOK
+5 SET (REQDA,DA(1))=+Y
DO STATCHK^DVBCUTL4
if $DATA(NCN)
HANG 2
if $DATA(NCN)
GOTO LOOK
+6 SET DFN=$PIECE(Y,U,2)
SET REQDT=$PIECE(^DVB(396.3,REQDA,0),U,2)
SET PNAM=$SELECT($DATA(^DPT(DFN,0)):$PIECE(^(0),U,1),1:"Unknown")
SET SSN=$SELECT($DATA(^(0)):$PIECE(^(0),U,9),1:"Not specified")
+7 SET CNUM=$SELECT($DATA(^DPT(DFN,.31)):$PIECE(^(.31),U,3),1:"Unknown")
KILL DICW
+8 FOR DA=0:0
SET DA=$ORDER(^DVB(396.4,"C",REQDA,DA))
if DA=""
QUIT
SET EXAM=$PIECE(^DVB(396.4,DA,0),U,3)
SET EXAM=$PIECE(^DVB(396.6,EXAM,0),U,1)
SET STAT=$PIECE(^DVB(396.4,DA,0),U,4)
SET ^TMP($JOB,EXAM)=STAT_U_DA
+9 ;
DATA KILL NCN,QUE
DO HDR^DVBCUTIL
+1 WRITE !
+2 SET Y=$$EXSRH^DVBCUTL4("Select Exam: ","I $D(^DVB(396.4,""ARQ""_REQDA,+Y))")
+3 if $DATA(DTOUT)
GOTO EXIT
if X=""!(X=U)
GOTO LOOK
+4 IF +Y<0
WRITE *7," ???"
GOTO DATA
+5 SET DVBCLCKD=$$XMLCK(+Y)
+6 IF +DVBCLCKD'=1
WRITE !!,*7,"This exam is currently being edited. <RETURN> to continue."
READ DVBCTST:DTIME
KILL DVBCTST
GOTO DATA
+7 SET (EXMDA,DA)=+Y
SET EXMNM=$PIECE(^DVB(396.4,+Y,0),U,3)
+8 SET EXMNM=$PIECE(^DVB(396.6,EXMNM,0),U,1)
+9 SET STAT=$PIECE(^TMP($JOB,EXMNM),U,1)
+10 DO STATCHK^DVBCUTL4
+11 IF STAT="C"
IF $PIECE(^DVB(396.4,EXMDA,0),U,10)]""
WRITE !,*7,"These exam results have been electronically signed.",!,"No editing is allowed!"
DO CONTMES^DVBCUTL4
SET DVBCLCKD=$$XMUNLCK(EXMDA)
GOTO DATA
+12 if STAT="C"
WRITE "But you may make changes until it is released.",!!
if STAT="C"
HANG 2
IF $DATA(NCN)&("^X^RX^"[STAT)
SET DVBCLCKD=$$XMUNLCK(EXMDA)
GOTO DATA
+13 IF STAT="T"
WRITE *7,!!,"This exam has been transferred to another facility.",!!
HANG 2
SET DVBCLCKD=$$XMUNLCK(EXMDA)
GOTO DATA
+14 KILL DR
SET (DIC,DIE)="^DVB(396.4,"
SET DR="W @FF;70;W @FF,!!;.06R;.07R"
+15 SET DA=EXMDA
DO ^DIE
DO COMP^DVBCUTL4
+16 SET DVBCLCKD=$$XMUNLCK(EXMDA)
+17 if $DATA(OUT)
GOTO EXIT
SET STAT1=$PIECE(^DVB(396.4,EXMDA,0),U,4)
SET $PIECE(^TMP($JOB,EXMNM),U,1)=STAT1
+18 SET NFINAL=0
+19 FOR EXMDA=0:0
SET EXMDA=$ORDER(^DVB(396.4,"C",REQDA,EXMDA))
if EXMDA=""
QUIT
SET STAT=$PIECE(^DVB(396.4,EXMDA,0),U,4)
IF STAT'="C"&(STAT'="X")&(STAT'="RX")
SET NFINAL=1
+20 IF NFINAL=0
IF $PIECE(^DVB(396.3,REQDA,0),U,12)=""
SET XMB="DVBA C 2507 EXAM READY"
SET XMB(1)=PNAM
SET XMB(2)=SSN
SET Y=REQDT
XECUTE ^DD("DD")
SET XREQDT=Y
SET XMB(3)=XREQDT
DO ^XMB
KILL XMB,XREQDT
+21 ;
+22 ;AJF;Request Status conversion
QUE KILL IO("Q"),%DT
SET QUE="N"
IF NFINAL=0
KILL DR
SET DIE="^DVB(396.3,"
SET DA=REQDA
SET DR="11///NOW;17////8"
DO ^DIE
SET %DT(0)=-DT
+1 ;
QUE1 KILL IO("Q")
WRITE !!,"Do you want to print a review copy"
SET %=2
DO YN^DICN
if $DATA(DTOUT)
GOTO EXIT
IF %=1
SET QUE="Y"
+1 IF $DATA(%Y)
IF %Y["?"
WRITE !!,"Enter Y to print a copy of the results for review",!,"or N to continue editing.",!!
HANG 2
GOTO QUE1
+2 IF QUE="Y"
SET (DA(1),DA)=REQDA
WRITE !!
SET %ZIS="AEQ"
DO ^%ZIS
KILL %ZIS
IF POP
SET QUE="N"
KILL IO("Q")
+3 IF '$DATA(IO("Q"))
IF QUE="Y"
SET EDPRT=1
USE IO
DO ZTSK^DVBCPRN1
KILL EDPRT,AUTO,ULINE,EXMNM,XEXMNM,PGHD,DVBCSITE
+4 IF $DATA(IO("Q"))
SET ZTRTN="ZTSK^DVBCPRN1"
SET ZTIO=ION
SET ZTDESC="2507 Review Report"
SET ZTDTH=$HOROLOG
FOR I="DVBC*","DUZ*","DA*","REQDA","EXMNM"
SET ZTSAVE(I)=""
+5 IF $DATA(IO("Q"))
DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE !!,"2507 Request queued for review to device "_ION,!!
HANG 2
KILL ZTRTN,ZTIO,ZTSAVE,ZTDTH,ZTSK,IO("Q")
+6 DO ^%ZISC
+7 IF QUE="Y"
GOTO LOOK
+8 GOTO DATA
+9 ;
EXIT KILL DVBCLCKD
if $DATA(ZTQUEUED)
DO KILL^%ZTLOAD
KILL WPTYPE,%DT
GOTO KILL^DVBCUTIL
+1 ;
KILL KILL ^TMP($JOB),DIC,DA,D0,D1,DFN,X,Y,OLDEXAM,REQDT,DR,EXMNM,NCN,STAT,NOFND,NFINAL,QUE,%,%Y,%ZIS,IOP
+1 QUIT
+2 ;
XMLCK(DA) ; ** Lock the 396.4 exam record selected for transcription **
+1 LOCK +^DVB(396.4,+DA,0):1
+2 QUIT $TEST
+3 ;
XMUNLCK(DA) ; ** Unlock the 396.4 exam record selected for transcription **
+1 LOCK -^DVB(396.4,DA,0)
+2 QUIT 0
