VASITE0.m

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

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