source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/VASITE0.m@ 1663

Last change on this file since 1663 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1VASITE0 ;ALB/AAS - ENTER/EDIT TIME SENSITIVE STATION NUMBER FILE ;11-FEB-92
2 ;;5.3;Registration;;Aug 13, 1993
3 ;
4% S U="^"
5ADD ; -entry to add new time sensitive entries
6 S DIR(0)="DO",DIR("A")="Select EFFECTIVE DATE",DIR("??")="^D HELP^VASITE0"
7 ;S:$D(VADT) DIR("B")=$$DATE(VADT)
8 D ^DIR K DIR G:Y<1 END S VADT=+Y W " ",$$DATE(VADT)
9 ;
10DIV S DIR(0)="PO^40.8:AEMQ",DIR("A")="Select MEDICAL CENTER DIVISION",DIR("??")="^D HELP1^VASITE0"
11 S:$D(VADIV) DIR("B")=$P($G(^DG(40.8,+VADIV,0)),"^")
12 D ^DIR K DIR G:Y<1 ADD S VADIV=+Y
13 ;
14 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
15 W !,"Filing New Entry!",! D FILE,EDIT:$D(DA)
16ADDQ K VADT,VADIV
17 G ADD
18END K VADT,VADIV,DIR,Y,X
19 Q
20 ;
21FILE ; -add new entry
22 L +^VA(389.9,0):10 I '$T W !,"Another user Editing, Try Again later" G FILEQ
23 S X=$P($G(^VA(389.9,0)),"^",3)+1
24 K DD,DO,DIC,DR S DIC="^VA(389.9,",DIC(0)="L",DLAYGO=389.9
25 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
26 S VAN=+Y,DIE="^VA(389.9,",DA=VAN,DR=".02////"_VADT_";.03////"_VADIV D ^DIE
27 L -^VA(389.9,0),-^VA(389.9,VAN)
28FILEQ K DR,DIC,DIE,X,Y,DO,DD,DINUM
29 Q
30 ;
31EDIT ; -Edit entry
32 ; input variable DA
33 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
34 W ! K DIC,DIE,DR,DA,Y,X
35 Q
36 ;
37HELP ;
38 W !!,"You may enter a new EFFECTIVE DATE or select from one of the following:"
39 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)
40 K VAI Q
41 ;
42HELP1 ;
43 W !!,"Select from the following Divisions"
44 S VAI=0 F S VAI=$O(^VA(389.9,"C",VAI)) Q:VAI="" W !?4,VAI
45 K VAI Q
46DATE(Y) ; convert date to external format
47 D D^DIQ
48 Q Y
Note: See TracBrowser for help on using the repository browser.