- 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 Mar 13, 2025@20:48:40 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
