- 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
