DVBAEDIT ;ALB ISC/THM-EDIT AMIE BENEFICIARY INFO STATUS ;21 JUL 89@0117
;;2.7;AMIE;**17**;Apr 10, 1995
I $D(DUZ)#2=0 W !!,*7,"You have no USER NUMBER. Contact the site manager.",!! H 3 G EXIT
;
TERM D HOME^%ZIS S OPER=$S($D(^VA(200,+DUZ,0)):$P(^(0),U,1),1:"Unknown operator")
S HD="7131 REQUEST STATUS EDITING"
;
SETUP W @IOF,!?(IOM-$L(HD)\2),HD,!! S DIE="^DVB(396,",DR="[DVBA STATUS EDIT]",DIC=DIE,DIC(0)="AEQMZ",DIC("A")="Enter PATIENT NAME: " K DVBACORR,OUT
D DICW^DVBAUTIL
S DVBACORR="N",SUPER=0 I $D(^XUSEC("DVBA SUPERVISOR",DUZ)) S SUPER=1,DVBACORR="Y"
;
EDIT D ^DIC G:X=U!(X="") EXIT W:Y<0 *7," ??" G:Y<0 EDIT I Y>0 S DVBAPNAM=Y(0,0),DA=+Y W !! G CHK
;;;OLD D ^DIC G:X=U!(X="") EXIT W:Y<0 *7," ??" G:Y<0 EDIT I Y>0 S DA=+Y W !! G CHK
;
EDIT1 K OUT,%,%Y S %DT(0)=-DT I SUPER=1 W !!!,*7,"Supervisory edit -- all fields available.",!!
I W "Note: As a Supervisor you will be allowed to use the ""^"" to escape",!,"from the program if desired. This is not normally allowed.",! S DIE("NO^")="OUTOK" D CON G:$D(OUT) FINAL
I SUPER=0 S DIE("NO^")=1
W @IOF,!,?(IOM-$L(HD)\2),HD,!!!,"Patient Name: ",DVBAPNAM D ^DIE K DIE("NO^")
; NEW FIX - W !,?(IOM-$L(HD)\2) D ^DIE K DIE("NO^")
;
FINAL D CHK1 G:NOFINAL=1 SETUP W !!,*7,"All items are completed. This record is now FINALIZED.",!
S DIE="^DVB(396,",DR="25////"_DT_";26////"_OPER W !,"Updating record, please wait ",! D ^DIE H 1
D CON G:$D(OUT) EXIT
K DA,Y G SETUP
;
EXIT W @IOF K DIE,DR,DIC,DIC(0),DIC("A"),DA,OPER,FDATE,%DT,X,NOFINAL,ZA,Y,%DT,HD,ANS,ZTYPE,DVBADIC,CODE,D0,DLAYGO,DQ,C,%X,%Y,%,DREF,DI,DIYS,ZX,%DT,DVBASTAT,DVBADT,CODE,ZX,FDT(0)
K DVBAPNAM,POP,DG,DIFLD,DK,DL,DM,SUPER,OUT,DVBACORR,D,OLDDR,DTOUT
Q
;
CHK ;CHECK TO SEE IF FINALIZED
K %,%Y
I SUPER=1,$D(^DVB(396,DA,1)),$P(^(1),U,12)]"" W *7,!,"This is finalized. Do you want to 'unfinalize' it" S %=1 D YN^DICN I $D(%Y),%Y["?" W !!,"Enter Y if you wish to reopen this and be able to edit it,",!,"or N to leave it as is",!! G CHK
G:$D(DTOUT) EXIT I SUPER=1,$D(%),%=1 S OLDDR=DR,DR="25///@",DIE="^DVB(396," D ^DIE S DR=OLDDR G EDIT1
I SUPER=1,$D(%),%'=1 G SETUP
I SUPER=0,$P(^DVB(396,DA,1),U,12)'="" S FDATE=$P(^(1),U,12) W !!,*7,"This record has already been finalized on ",$$FMTE^XLFDT(FDATE,"5DZ"),! H 3 G SETUP
G EDIT1
;
CHK1 ;CHECK STATUS OF EACH FIELD
S NOFINAL=0
F ZA=9,11,13,15,17,19,21,23,26,28 I $P(^DVB(396,DA,0),U,ZA)="P" S NOFINAL=1 Q
Q:NOFINAL=1 I $P(^DVB(396,DA,1),U,7)="P" S NOFINAL=1 Q
Q
CON ;continue
W !!,"Press RETURN to continue or ""^"" to exit " R ANS:DTIME S:'$T!(ANS=U) OUT=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBAEDIT 2601 printed Apr 09, 2024@20:46:46 Page 2
DVBAEDIT ;ALB ISC/THM-EDIT AMIE BENEFICIARY INFO STATUS ;21 JUL 89@0117
+1 ;;2.7;AMIE;**17**;Apr 10, 1995
+2 IF $DATA(DUZ)#2=0
WRITE !!,*7,"You have no USER NUMBER. Contact the site manager.",!!
HANG 3
GOTO EXIT
+3 ;
TERM DO HOME^%ZIS
SET OPER=$SELECT($DATA(^VA(200,+DUZ,0)):$PIECE(^(0),U,1),1:"Unknown operator")
+1 SET HD="7131 REQUEST STATUS EDITING"
+2 ;
SETUP WRITE @IOF,!?(IOM-$LENGTH(HD)\2),HD,!!
SET DIE="^DVB(396,"
SET DR="[DVBA STATUS EDIT]"
SET DIC=DIE
SET DIC(0)="AEQMZ"
SET DIC("A")="Enter PATIENT NAME: "
KILL DVBACORR,OUT
+1 DO DICW^DVBAUTIL
+2 SET DVBACORR="N"
SET SUPER=0
IF $DATA(^XUSEC("DVBA SUPERVISOR",DUZ))
SET SUPER=1
SET DVBACORR="Y"
+3 ;
EDIT DO ^DIC
if X=U!(X="")
GOTO EXIT
if Y<0
WRITE *7," ??"
if Y<0
GOTO EDIT
IF Y>0
SET DVBAPNAM=Y(0,0)
SET DA=+Y
WRITE !!
GOTO CHK
+1 ;;;OLD D ^DIC G:X=U!(X="") EXIT W:Y<0 *7," ??" G:Y<0 EDIT I Y>0 S DA=+Y W !! G CHK
+2 ;
EDIT1 KILL OUT,%,%Y
SET %DT(0)=-DT
IF SUPER=1
WRITE !!!,*7,"Supervisory edit -- all fields available.",!!
+1 IF $TEST
WRITE "Note: As a Supervisor you will be allowed to use the ""^"" to escape",!,"from the program if desired. This is not normally allowed.",!
SET DIE("NO^")="OUTOK"
DO CON
if $DATA(OUT)
GOTO FINAL
+2 IF SUPER=0
SET DIE("NO^")=1
+3 WRITE @IOF,!,?(IOM-$LENGTH(HD)\2),HD,!!!,"Patient Name: ",DVBAPNAM
DO ^DIE
KILL DIE("NO^")
+4 ; NEW FIX - W !,?(IOM-$L(HD)\2) D ^DIE K DIE("NO^")
+5 ;
FINAL DO CHK1
if NOFINAL=1
GOTO SETUP
WRITE !!,*7,"All items are completed. This record is now FINALIZED.",!
+1 SET DIE="^DVB(396,"
SET DR="25////"_DT_";26////"_OPER
WRITE !,"Updating record, please wait ",!
DO ^DIE
HANG 1
+2 DO CON
if $DATA(OUT)
GOTO EXIT
+3 KILL DA,Y
GOTO SETUP
+4 ;
EXIT WRITE @IOF
KILL DIE,DR,DIC,DIC(0),DIC("A"),DA,OPER,FDATE,%DT,X,NOFINAL,ZA,Y,%DT,HD,ANS,ZTYPE,DVBADIC,CODE,D0,DLAYGO,DQ,C,%X,%Y,%,DREF,DI,DIYS,ZX,%DT,DVBASTAT,DVBADT,CODE,ZX,FDT(0)
+1 KILL DVBAPNAM,POP,DG,DIFLD,DK,DL,DM,SUPER,OUT,DVBACORR,D,OLDDR,DTOUT
+2 QUIT
+3 ;
CHK ;CHECK TO SEE IF FINALIZED
+1 KILL %,%Y
+2 IF SUPER=1
IF $DATA(^DVB(396,DA,1))
IF $PIECE(^(1),U,12)]""
WRITE *7,!,"This is finalized. Do you want to 'unfinalize' it"
SET %=1
DO YN^DICN
IF $DATA(%Y)
IF %Y["?"
WRITE !!,"Enter Y if you wish to reopen this and be able to edit it,",!,"or N to leave it as is",!!
GOTO CHK
+3 if $DATA(DTOUT)
GOTO EXIT
IF SUPER=1
IF $DATA(%)
IF %=1
SET OLDDR=DR
SET DR="25///@"
SET DIE="^DVB(396,"
DO ^DIE
SET DR=OLDDR
GOTO EDIT1
+4 IF SUPER=1
IF $DATA(%)
IF %'=1
GOTO SETUP
+5 IF SUPER=0
IF $PIECE(^DVB(396,DA,1),U,12)'=""
SET FDATE=$PIECE(^(1),U,12)
WRITE !!,*7,"This record has already been finalized on ",$$FMTE^XLFDT(FDATE,"5DZ"),!
HANG 3
GOTO SETUP
+6 GOTO EDIT1
+7 ;
CHK1 ;CHECK STATUS OF EACH FIELD
+1 SET NOFINAL=0
+2 FOR ZA=9,11,13,15,17,19,21,23,26,28
IF $PIECE(^DVB(396,DA,0),U,ZA)="P"
SET NOFINAL=1
QUIT
+3 if NOFINAL=1
QUIT
IF $PIECE(^DVB(396,DA,1),U,7)="P"
SET NOFINAL=1
QUIT
+4 QUIT
CON ;continue
+1 WRITE !!,"Press RETURN to continue or ""^"" to exit "
READ ANS:DTIME
if '$TEST!(ANS=U)
SET OUT=1
+2 QUIT
