| 1 | DVBCLOG ;ALB/GTS-557/THM-LOG A 2507 REQUEST ; 9/21/91 9:26 PM
|
|---|
| 2 | ;;2.7;AMIE;;Apr 10, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | I '$D(DUZ(2)) W *7,!!,"Your division number is missing.",!! H 3 G EXIT
|
|---|
| 5 | I $D(DUZ)#2=0 W !!,*7,"Your user number is invalid." H 3 G EXIT
|
|---|
| 6 | I +DUZ(2)<1 W !!,*7,"Invalid division",!! H 3 G EXIT
|
|---|
| 7 | ;
|
|---|
| 8 | 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"
|
|---|
| 9 | ;
|
|---|
| 10 | EN D KILL W @FF,?(IOM-$L(HD1)\2),HD1,!!! D ^DVBCPATA I $D(OUT) K OUT G EXIT
|
|---|
| 11 | S %DT="TS",X="NOW" D ^%DT S CTIM=Y K X,Y,%DT
|
|---|
| 12 | I $D(EDIT) K EDIT W @IOF,!,HD1," continued ---",!!!!!!
|
|---|
| 13 | ;
|
|---|
| 14 | 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
|
|---|
| 15 | I $D(%Y),%Y["?" W !!,"Enter Y to proceed with the request or N to go",!,"back and re-select.",!! G WARD
|
|---|
| 16 | I $D(%),%'=1 G EN
|
|---|
| 17 | K DVBCNEW,DA,DD,DO,X,Y W !!
|
|---|
| 18 | S DIC="^DVB(396.3,",DIE=DIC,DIC(0)="EQLM",X=DFN,DLAYGO=396.3
|
|---|
| 19 | 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
|
|---|
| 20 | I +Y<0 H 2 G EN ;deletions via ^ in file^dicn
|
|---|
| 21 | S (DA,REQDA)=+Y
|
|---|
| 22 | D:$P(^DVB(396.3,REQDA,0),"^",10)="E" INSUF^DVBCLOG2
|
|---|
| 23 | I $D(DVBAOUT) D DEL G EN
|
|---|
| 24 | ;
|
|---|
| 25 | 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
|
|---|
| 26 | I ANS[U W *7,!!,"""^"" NOT allowed here" G EDIT1
|
|---|
| 27 | 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
|
|---|
| 28 | 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
|
|---|
| 29 | I ANS="E"&($D(DVBAINRQ)&($P(^DVB(396.3,REQDA,0),"^",10)="E")) DO
|
|---|
| 30 | .S DIR(0)="Y^AO",DIR("A")="Do you want to change the request this insufficient is linked to? "
|
|---|
| 31 | .S DIR("?")="Enter Yes to change the link and No to keep the current link",DIR("B")="NO" D ^DIR
|
|---|
| 32 | .I +Y=1 K DIR,Y D CLINSF^DVBCLOG2 S DA=REQDA D INSUF^DVBCLOG2
|
|---|
| 33 | I ANS="E"&('$D(DVBAINRQ)&($P(^DVB(396.3,REQDA,0),"^",10)="E")) D INSUF^DVBCLOG2
|
|---|
| 34 | I ANS="E",($D(DVBAOUT)) D DEL G EN
|
|---|
| 35 | I ANS="E" K DVBAINRQ G EDIT1
|
|---|
| 36 | I ANS="X" W !?20,"(Cancel) " D DEL K ANS G EN
|
|---|
| 37 | I ANS'?1"E"&(ANS'?1"X")&(ANS'?1"") W !!,*7,"Must be the RETURN key, X, or E " G EDIT1
|
|---|
| 38 | K DIC,DIE,ANS D ^DVBCLOGE I $D(OUT) K OUT D DEL
|
|---|
| 39 | I $D(DVBCLCKD) D DEL
|
|---|
| 40 | H 1 D KILL G EN
|
|---|
| 41 | ;
|
|---|
| 42 | EXIT G KILL^DVBCUTIL
|
|---|
| 43 | ;
|
|---|
| 44 | HDR W @FF,?(IOM-$L(HD)\2),HD,!!,"Veteran name: ",$P(PNAM,",",2,99)," ",$P(PNAM,",",1),?55,"SSN: ",SSN,!?53,"C-NUM: ",CNUM,!
|
|---|
| 45 | F LINE=1:1:IOM W "="
|
|---|
| 46 | W ! Q
|
|---|
| 47 | ;
|
|---|
| 48 | 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
|
|---|
| 49 | ;
|
|---|
| 50 | 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
|
|---|
| 51 | 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
|
|---|
| 52 | Q
|
|---|
| 53 | ;
|
|---|
| 54 | DR S DIC("DR")="1////"_CTIM_";17////N"_";2////^S X=DUZ(2);3////^S X=DUZ;9;10;10.1;10.2;S %DT(0)=-DT;29;21;24" Q
|
|---|
