VASITE0 ;ALB/AAS - ENTER/EDIT TIME SENSITIVE STATION NUMBER FILE ;11-FEB-92
;;5.3;Registration;;Aug 13, 1993
;
% S U="^"
ADD ; -entry to add new time sensitive entries
S DIR(0)="DO",DIR("A")="Select EFFECTIVE DATE",DIR("??")="^D HELP^VASITE0"
;S:$D(VADT) DIR("B")=$$DATE(VADT)
D ^DIR K DIR G:Y<1 END S VADT=+Y W " ",$$DATE(VADT)
;
DIV S DIR(0)="PO^40.8:AEMQ",DIR("A")="Select MEDICAL CENTER DIVISION",DIR("??")="^D HELP1^VASITE0"
S:$D(VADIV) DIR("B")=$P($G(^DG(40.8,+VADIV,0)),"^")
D ^DIR K DIR G:Y<1 ADD S VADIV=+Y
;
I $D(^VA(389.9,"AIVDT",VADIV,-VADT)) S X=VADIV,DIC(0)="EMQF",DIC="^VA(389.9,",DIC("S")="I $P(^(0),U,3)=VADIV,$P(^(0),U,2)=VADT" D ^DIC K DIC Q:Y<1 S DA=+Y D EDIT G ADDQ
W !,"Filing New Entry!",! D FILE,EDIT:$D(DA)
ADDQ K VADT,VADIV
G ADD
END K VADT,VADIV,DIR,Y,X
Q
;
FILE ; -add new entry
L +^VA(389.9,0):10 I '$T W !,"Another user Editing, Try Again later" G FILEQ
S X=$P($G(^VA(389.9,0)),"^",3)+1
K DD,DO,DIC,DR S DIC="^VA(389.9,",DIC(0)="L",DLAYGO=389.9
F X=X:1 I X>0,'$D(^VA(389.9,X)) L +^VA(389.9,X):1 I $T,'$D(^VA(389.9,X)) S DINUM=X D FILE^DICN I +Y>0 Q
S VAN=+Y,DIE="^VA(389.9,",DA=VAN,DR=".02////"_VADT_";.03////"_VADIV D ^DIE
L -^VA(389.9,0),-^VA(389.9,VAN)
FILEQ K DR,DIC,DIE,X,Y,DO,DD,DINUM
Q
;
EDIT ; -Edit entry
; input variable DA
S DIE="^VA(389.9,",DR=".01;.02;.03;.04//"_$P($G(^DIC(4,+$P(^DG(40.8,+VADIV,0),"^",7),99)),"^")_";.05;.06:" D ^DIE
W ! K DIC,DIE,DR,DA,Y,X
Q
;
HELP ;
W !!,"You may enter a new EFFECTIVE DATE or select from one of the following:"
S VAI=0 F S VAI=$O(^VA(389.9,"E",VAI)) Q:'VAI S VAJ=0 F S VAJ=$O(^VA(389.9,"E",VAI,VAJ)) Q:'VAJ W !?4,$$DATE(VAI),?20,$E($P($G(^DG(40.8,+$P($G(^VA(389.9,VAJ,0)),"^",3),0)),"^"),1,25),?48,$P($G(^VA(389.9,VAJ,0)),"^",4)
K VAI Q
;
HELP1 ;
W !!,"Select from the following Divisions"
S VAI=0 F S VAI=$O(^VA(389.9,"C",VAI)) Q:VAI="" W !?4,VAI
K VAI Q
DATE(Y) ; convert date to external format
D D^DIQ
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HVASITE0 1990 printed Nov 22, 2024@18:13:54 Page 2
VASITE0 ;ALB/AAS - ENTER/EDIT TIME SENSITIVE STATION NUMBER FILE ;11-FEB-92
+1 ;;5.3;Registration;;Aug 13, 1993
+2 ;
% SET U="^"
ADD ; -entry to add new time sensitive entries
+1 SET DIR(0)="DO"
SET DIR("A")="Select EFFECTIVE DATE"
SET DIR("??")="^D HELP^VASITE0"
+2 ;S:$D(VADT) DIR("B")=$$DATE(VADT)
+3 DO ^DIR
KILL DIR
if Y<1
GOTO END
SET VADT=+Y
WRITE " ",$$DATE(VADT)
+4 ;
DIV SET DIR(0)="PO^40.8:AEMQ"
SET DIR("A")="Select MEDICAL CENTER DIVISION"
SET DIR("??")="^D HELP1^VASITE0"
+1 if $DATA(VADIV)
SET DIR("B")=$PIECE($GET(^DG(40.8,+VADIV,0)),"^")
+2 DO ^DIR
KILL DIR
if Y<1
GOTO ADD
SET VADIV=+Y
+3 ;
+4 IF $DATA(^VA(389.9,"AIVDT",VADIV,-VADT))
SET X=VADIV
SET DIC(0)="EMQF"
SET DIC="^VA(389.9,"
SET DIC("S")="I $P(^(0),U,3)=VADIV,$P(^(0),U,2)=VADT"
DO ^DIC
KILL DIC
if Y<1
QUIT
SET DA=+Y
DO EDIT
GOTO ADDQ
+5 WRITE !,"Filing New Entry!",!
DO FILE
if $DATA(DA)
DO EDIT
ADDQ KILL VADT,VADIV
+1 GOTO ADD
END KILL VADT,VADIV,DIR,Y,X
+1 QUIT
+2 ;
FILE ; -add new entry
+1 LOCK +^VA(389.9,0):10
IF '$TEST
WRITE !,"Another user Editing, Try Again later"
GOTO FILEQ
+2 SET X=$PIECE($GET(^VA(389.9,0)),"^",3)+1
+3 KILL DD,DO,DIC,DR
SET DIC="^VA(389.9,"
SET DIC(0)="L"
SET DLAYGO=389.9
+4 FOR X=X:1
IF X>0
IF '$DATA(^VA(389.9,X))
LOCK +^VA(389.9,X):1
IF $TEST
IF '$DATA(^VA(389.9,X))
SET DINUM=X
DO FILE^DICN
IF +Y>0
QUIT
+5 SET VAN=+Y
SET DIE="^VA(389.9,"
SET DA=VAN
SET DR=".02////"_VADT_";.03////"_VADIV
DO ^DIE
+6 LOCK -^VA(389.9,0),-^VA(389.9,VAN)
FILEQ KILL DR,DIC,DIE,X,Y,DO,DD,DINUM
+1 QUIT
+2 ;
EDIT ; -Edit entry
+1 ; input variable DA
+2 SET DIE="^VA(389.9,"
SET DR=".01;.02;.03;.04//"_$PIECE($GET(^DIC(4,+$PIECE(^DG(40.8,+VADIV,0),"^",7),99)),"^")_";.05;.06:"
DO ^DIE
+3 WRITE !
KILL DIC,DIE,DR,DA,Y,X
+4 QUIT
+5 ;
HELP ;
+1 WRITE !!,"You may enter a new EFFECTIVE DATE or select from one of the following:"
+2 SET VAI=0
FOR
SET VAI=$ORDER(^VA(389.9,"E",VAI))
if 'VAI
QUIT
SET VAJ=0
FOR
SET VAJ=$ORDER(^VA(389.9,"E",VAI,VAJ))
if 'VAJ
QUIT
WRITE !?4,$$DATE(VAI),?20,$EXTRACT($PIECE($GET(^DG(40.8,+$PIECE($GET(^VA(389.9,VAJ,0)),"^",3),0)),"^"),1,25),?48,$PIECE($GET(^VA(389.9,VAJ,0)),"^",4)
+3 KILL VAI
QUIT
+4 ;
HELP1 ;
+1 WRITE !!,"Select from the following Divisions"
+2 SET VAI=0
FOR
SET VAI=$ORDER(^VA(389.9,"C",VAI))
if VAI=""
QUIT
WRITE !?4,VAI
+3 KILL VAI
QUIT
DATE(Y) ; convert date to external format
+1 DO D^DIQ
+2 QUIT Y
