DVBCLOG ;ALB/GTS-557/THM-LOG A 2507 REQUEST ; 9/21/91 9:26 PM
;;2.7;AMIE;**193**;Apr 10, 1995;Build 84
;
I '$D(DUZ(2)) W *7,!!,"Your division number is missing.",!! H 3 G EXIT
I $D(DUZ)#2=0 W !!,*7,"Your user number is invalid." H 3 G EXIT
I +DUZ(2)<1 W !!,*7,"Invalid division",!! H 3 G EXIT
;
SETUP K ^TMP($J) D HOME^%ZIS S FF=IOF,HD="C & P Request Entry for",HD1="C & P Request Veteran Selection",HD2="Exam selection"
;
EN D KILL W @FF,?(IOM-$L(HD1)\2),HD1,!!! D ^DVBCPATA I $D(OUT) K OUT G EXIT
S %DT="TS",X="NOW" D ^%DT S CTIM=Y K X,Y,%DT
I $D(EDIT) K EDIT W @IOF,!,HD1," continued ---",!!!!!!
;
WARD S WARD=$S($D(^DPT(DFN,.1)):$P(^(.1),U,1),1:"") I WARD]"" W *7,"Vet is an INPATIENT, on ward "_WARD,!,"Want to continue" S %=2 D YN^DICN I $D(DTOUT) G EXIT
I $D(%Y),%Y["?" W !!,"Enter Y to proceed with the request or N to go",!,"back and re-select.",!! G WARD
I $D(%),%'=1 G EN
K DVBCNEW,DA,DD,DO,X,Y W !!
S DIC="^DVB(396.3,",DIE=DIC,DIC(0)="EQLM",X=DFN,DLAYGO=396.3
K OUT D HDR,^DVBCEEXM,DDIS^DVBCUTL2 K DIC("W") S X=DFN D DR,FILE^DICN K DLAYGO I $D(DTOUT) W *7," ... Timed out! " H 1 W *7 S REQDA=+Y D DEL G EN
I +Y<0 H 2 G EN ;deletions via ^ in file^dicn
S (DA,REQDA)=+Y
D:$P(^DVB(396.3,REQDA,0),"^",10)="E" INSUF^DVBCLOG2
I $D(DVBAOUT) D DEL G EN
;
EDIT1 K ANS W !!,"Select action:",!!," Press [RETURN] to continue, or enter E to edit or X to cancel: Continue// " R ANS:DTIME I '$T D DEL G EXIT
I ANS[U W *7,!!,"""^"" NOT allowed here" G EDIT1
I ANS["?" W !!,"[RETURN] will continue to exam selection, E will allow",!,"editing of what you have entered and X will DELETE",!,"the entire request" G EDIT1
I ANS="E" K DVBAINRQ S:$P(^DVB(396.3,REQDA,0),"^",10)="E" DVBAINRQ="" W !?20,"(Edit) " H 1 S DA=REQDA,DIE="^DVB(396.3,",DR="9;10:10.2;29;21;24" D HDR,^DIE D:$P(^DVB(396.3,REQDA,0),"^",10)'="E"&($D(DVBAINRQ)) CLINSF^DVBCLOG2
I ANS="E"&($D(DVBAINRQ)&($P(^DVB(396.3,REQDA,0),"^",10)="E")) DO
.S DIR(0)="Y^AO",DIR("A")="Do you want to change the request this insufficient is linked to? "
.S DIR("?")="Enter Yes to change the link and No to keep the current link",DIR("B")="NO" D ^DIR
.I +Y=1 K DIR,Y D CLINSF^DVBCLOG2 S DA=REQDA D INSUF^DVBCLOG2
I ANS="E"&('$D(DVBAINRQ)&($P(^DVB(396.3,REQDA,0),"^",10)="E")) D INSUF^DVBCLOG2
I ANS="E",($D(DVBAOUT)) D DEL G EN
I ANS="E" K DVBAINRQ G EDIT1
I ANS="X" W !?20,"(Cancel) " D DEL K ANS G EN
I ANS'?1"E"&(ANS'?1"X")&(ANS'?1"") W !!,*7,"Must be the RETURN key, X, or E " G EDIT1
K DIC,DIE,ANS D ^DVBCLOGE I $D(OUT) K OUT D DEL
I $D(DVBCLCKD) D DEL
H 1 D KILL G EN
;
EXIT G KILL^DVBCUTIL
;
HDR W @FF,?(IOM-$L(HD)\2),HD,!!,"Veteran name: ",$P(PNAM,",",2,99)," ",$P(PNAM,",",1),?55,"SSN: ",SSN,!?53,"C-NUM: ",CNUM,!
F LINE=1:1:IOM W "="
W ! Q
;
DEL S DIK="^DVB(396.3,",DA=REQDA D ^DIK W !!,*7,"Request DELETED.",! K DIK,REQDA,DA S OUT=1 D CONTMES^DVBCUTL4 Q
;
KILL K %DT,CNUM,DFN,DIK,DR,DTA,DXCOD,DXNUM,EDIT,EX,ROUTLOC,EXMNM,EXMPT,PNAM,SSN,PCT,SC,REQDA,VX,JJ,X,%,^TMP($J),DA,DO,DD
K Y,DVBCNEW,DIC,DIE,Y,DA,%Y,ADD1,ADD2,CITY,CNTY,CTIM,D0,DX,ELIG,INCMP,PRDSV,STATE,WARD,ZIP,DUOUT,DTOUT,DVBCLCKD,DVBAOUT,DVBADTOT
Q
;
;AJF;Request Status conversion
DR S DIC("DR")="1////"_CTIM_";17////1"_";2////^S X=DUZ(2);3////^S X=DUZ;9;10;10.1;10.2;S %DT(0)=-DT;29;21;24" Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDVBCLOG 3310 printed Apr 09, 2024@20:47:19 Page 2
DVBCLOG ;ALB/GTS-557/THM-LOG A 2507 REQUEST ; 9/21/91 9:26 PM
+1 ;;2.7;AMIE;**193**;Apr 10, 1995;Build 84
+2 ;
+3 IF '$DATA(DUZ(2))
WRITE *7,!!,"Your division number is missing.",!!
HANG 3
GOTO EXIT
+4 IF $DATA(DUZ)#2=0
WRITE !!,*7,"Your user number is invalid."
HANG 3
GOTO EXIT
+5 IF +DUZ(2)<1
WRITE !!,*7,"Invalid division",!!
HANG 3
GOTO EXIT
+6 ;
SETUP KILL ^TMP($JOB)
DO HOME^%ZIS
SET FF=IOF
SET HD="C & P Request Entry for"
SET HD1="C & P Request Veteran Selection"
SET HD2="Exam selection"
+1 ;
EN DO KILL
WRITE @FF,?(IOM-$LENGTH(HD1)\2),HD1,!!!
DO ^DVBCPATA
IF $DATA(OUT)
KILL OUT
GOTO EXIT
+1 SET %DT="TS"
SET X="NOW"
DO ^%DT
SET CTIM=Y
KILL X,Y,%DT
+2 IF $DATA(EDIT)
KILL EDIT
WRITE @IOF,!,HD1," continued ---",!!!!!!
+3 ;
WARD SET WARD=$SELECT($DATA(^DPT(DFN,.1)):$PIECE(^(.1),U,1),1:"")
IF WARD]""
WRITE *7,"Vet is an INPATIENT, on ward "_WARD,!,"Want to continue"
SET %=2
DO YN^DICN
IF $DATA(DTOUT)
GOTO EXIT
+1 IF $DATA(%Y)
IF %Y["?"
WRITE !!,"Enter Y to proceed with the request or N to go",!,"back and re-select.",!!
GOTO WARD
+2 IF $DATA(%)
IF %'=1
GOTO EN
+3 KILL DVBCNEW,DA,DD,DO,X,Y
WRITE !!
+4 SET DIC="^DVB(396.3,"
SET DIE=DIC
SET DIC(0)="EQLM"
SET X=DFN
SET DLAYGO=396.3
+5 KILL OUT
DO HDR
DO ^DVBCEEXM
DO DDIS^DVBCUTL2
KILL DIC("W")
SET X=DFN
DO DR
DO FILE^DICN
KILL DLAYGO
IF $DATA(DTOUT)
WRITE *7," ... Timed out! "
HANG 1
WRITE *7
SET REQDA=+Y
DO DEL
GOTO EN
+6 ;deletions via ^ in file^dicn
IF +Y<0
HANG 2
GOTO EN
+7 SET (DA,REQDA)=+Y
+8 if $PIECE(^DVB(396.3,REQDA,0),"^",10)="E"
DO INSUF^DVBCLOG2
+9 IF $DATA(DVBAOUT)
DO DEL
GOTO EN
+10 ;
EDIT1 KILL ANS
WRITE !!,"Select action:",!!," Press [RETURN] to continue, or enter E to edit or X to cancel: Continue// "
READ ANS:DTIME
IF '$TEST
DO DEL
GOTO EXIT
+1 IF ANS[U
WRITE *7,!!,"""^"" NOT allowed here"
GOTO EDIT1
+2 IF ANS["?"
WRITE !!,"[RETURN] will continue to exam selection, E will allow",!,"editing of what you have entered and X will DELETE",!,"the entire request"
GOTO EDIT1
+3 IF ANS="E"
KILL DVBAINRQ
if $PIECE(^DVB(396.3,REQDA,0),"^",10)="E"
SET DVBAINRQ=""
WRITE !?20,"(Edit) "
HANG 1
SET DA=REQDA
SET DIE="^DVB(396.3,"
SET DR="9;10:10.2;29;21;24"
DO HDR
DO ^DIE
if $PIECE(^DVB(396.3,REQDA,0),"^",10)'="E"&($DATA(DVBAINRQ))
DO CLINSF^DVBCLOG2
+4 IF ANS="E"&($DATA(DVBAINRQ)&($PIECE(^DVB(396.3,REQDA,0),"^",10)="E"))
Begin DoDot:1
+5 SET DIR(0)="Y^AO"
SET DIR("A")="Do you want to change the request this insufficient is linked to? "
+6 SET DIR("?")="Enter Yes to change the link and No to keep the current link"
SET DIR("B")="NO"
DO ^DIR
+7 IF +Y=1
KILL DIR,Y
DO CLINSF^DVBCLOG2
SET DA=REQDA
DO INSUF^DVBCLOG2
End DoDot:1
+8 IF ANS="E"&('$DATA(DVBAINRQ)&($PIECE(^DVB(396.3,REQDA,0),"^",10)="E"))
DO INSUF^DVBCLOG2
+9 IF ANS="E"
IF ($DATA(DVBAOUT))
DO DEL
GOTO EN
+10 IF ANS="E"
KILL DVBAINRQ
GOTO EDIT1
+11 IF ANS="X"
WRITE !?20,"(Cancel) "
DO DEL
KILL ANS
GOTO EN
+12 IF ANS'?1"E"&(ANS'?1"X")&(ANS'?1"")
WRITE !!,*7,"Must be the RETURN key, X, or E "
GOTO EDIT1
+13 KILL DIC,DIE,ANS
DO ^DVBCLOGE
IF $DATA(OUT)
KILL OUT
DO DEL
+14 IF $DATA(DVBCLCKD)
DO DEL
+15 HANG 1
DO KILL
GOTO EN
+16 ;
EXIT GOTO KILL^DVBCUTIL
+1 ;
HDR WRITE @FF,?(IOM-$LENGTH(HD)\2),HD,!!,"Veteran name: ",$PIECE(PNAM,",",2,99)," ",$PIECE(PNAM,",",1),?55,"SSN: ",SSN,!?53,"C-NUM: ",CNUM,!
+1 FOR LINE=1:1:IOM
WRITE "="
+2 WRITE !
QUIT
+3 ;
DEL SET DIK="^DVB(396.3,"
SET DA=REQDA
DO ^DIK
WRITE !!,*7,"Request DELETED.",!
KILL DIK,REQDA,DA
SET OUT=1
DO CONTMES^DVBCUTL4
QUIT
+1 ;
KILL KILL %DT,CNUM,DFN,DIK,DR,DTA,DXCOD,DXNUM,EDIT,EX,ROUTLOC,EXMNM,EXMPT,PNAM,SSN,PCT,SC,REQDA,VX,JJ,X,%,^TMP($JOB),DA,DO,DD
+1 KILL Y,DVBCNEW,DIC,DIE,Y,DA,%Y,ADD1,ADD2,CITY,CNTY,CTIM,D0,DX,ELIG,INCMP,PRDSV,STATE,WARD,ZIP,DUOUT,DTOUT,DVBCLCKD,DVBAOUT,DVBADTOT
+2 QUIT
+3 ;
+4 ;AJF;Request Status conversion
DR SET DIC("DR")="1////"_CTIM_";17////1"_";2////^S X=DUZ(2);3////^S X=DUZ;9;10;10.1;10.2;S %DT(0)=-DT;29;21;24"
QUIT
