source: FOIAVistA/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBCSCHD.m@ 1757

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1DVBCSCHD ;ALB/GTS-557/THM-SCHEDULE C&P EXAMS ; 9/23/91 9:54 AM
2 ;;2.7;AMIE;**17**;Apr 10, 1995
3 ;
4 ;** Version Changes
5 ; 2.7 - GTS/Set DVBADA,DVBASDRT SD Event driver (Enhc 13)
6 ;
7SETUP D HOME^%ZIS S HD="SCHEDULE C&P EXAMS",FF=IOF
8 I $D(DUZ)#2=0 W *7,!!,"You have no user number !",!! H 3 G EXIT
9 S SUPER=0 I $D(^XUSEC("DVBA C SUPERVISOR",DUZ)) S SUPER=1
10 ;
11EN D ZAP W @FF,?(IOM-$L(HD)\2),HD,!!!
12 S DIC="^DVB(396.3,",DIC(0)="AEQM",DIC("A")="Enter VETERAN NAME: ",DIC("W")="D DICW^DVBCUTIL"
13 D ^DIC G:X=""!(X[U)!($D(DTOUT)) EXIT
14 I +Y>0 S (OLDDA,REQDA)=+Y,DFN=$P(Y,U,2)
15 I $O(^DVB(396.4,"C",REQDA,0))="" W !!,*7,"This request has no exams on it and should",!,"be completely cancelled.",!! H 3 G EN
16 D GO1 I '$D(TFIND) W !!,*7,"This request has been completely transferred to another site.",!,"Scheduling will not be allowed.",!! H 3 G EN
17 S STAT=$P(^DVB(396.3,+Y,0),U,18) D STATCHK I $D(NCN) G EN
18 S DTSCHED=$P(^DVB(396.3,+Y,0),U,6) I DTSCHED]"" W !!,*7,"Scheduling has been completed for this request as of ",$$FMTE^XLFDT(DTSCHED,"5DZ")_".",!
19 I DTSCHED]"",SUPER=0 W "Only supervisors can change it.",!! H 3 G EN
20 ;
21ASK K %,%Y I DTSCHED]"",SUPER=1 W "Do you want to change" S %=2 D YN^DICN G:$D(DTOUT)!(%<0) EXIT
22 I $D(%Y),%Y["?" W !!,"Enter Y to be able to change the scheduling information or N to backup.",!! G ASK
23 I $D(%),%'=1 G EN
24 ;
25ASK1 I $D(^DVB(396.3,REQDA,4)),$P(^(4),U,1)="y" W !!,"Note: One or more exams on this request have transferred out."
26 W !!,"Do you want to make an appointment for a clinic" S %=1 D YN^DICN G:$D(DTOUT)!(%<0) EXIT I %=1 W @FF,"Schedule a Clinic Appointment for 2507 Exam",!!! S ORACTION=1,DVBADA=REQDA,DVBASDRT="",ORVP=DFN D OERR^SDM
27 I $D(%Y),%Y["?" W !!,"Enter Y to make an appointment via ADT/Scheduling or N to skip." G ASK1
28 ;
29EN1 W @FF,"Enter Scheduling Information for 2507 Exams",!!
30 ;
31ASK2 W !,"Has scheduling for all exams been completed" S %=2 D YN^DICN G:$D(DTOUT)!(%<0) EXIT
32 I $D(%Y),%Y["?" W !!,"Enter Y if scheduling is completed, N if not.",!! G ASK2
33 G:%'=1 EN
34 W !!,"Ok, then please complete the following:",!!
35 S:$P(^DVB(396.3,REQDA,0),U,6)="" DR="5///NOW",DIE="^DVB(396.3,",DA=REQDA D ^DIE:$P(^DVB(396.3,REQDA,0),U,6)="",EXAMS I '$D(Y) G EN
36 I $D(Y) W *7,!!,"Important scheduling information is missing!",!,"2507 file NOT updated!",!! S DR="5///@",DIE="^DVB(396.3,",DA=REQDA D ^DIE H 2 G EN ;delete date if "^"
37 ;
38ZAP K %,%Y,NCN,DFN,EXAM,JDR,JDT,DTSCHED,REQDA,RO,RONAME,STAT,TFIND,TSTDT
39 Q
40 ;
41EXIT K TFIND,ORACTION,ORVP,DVBAXJ,DVBASDRT G KILL^DVBCUTIL
42 ;
43STATCHK Q:STAT="P"!(STAT="N")!(STAT="NT")!(STAT="S")!(STAT="O")
44 W !!,*7,"This request has been ",$S(STAT="RX":"cancelled by the RO",STAT="X":"cancelled by MAS",STAT="T":"transcribed",STAT="R":"released",STAT="C":"completed",STAT="CT":"completed, transferred out",1:"given an incorrect status"),".",!!
45 S NCN=1 H 2 Q
46 ;NCN=no can do
47 Q
48 ;
49EXAMS H 1 S DA(1)=REQDA
50 F DA=0:0 S DA=$O(^DVB(396.4,"C",DA(1),DA)) Q:DA=""!(+DA=0) S EXNAME=+$P(^DVB(396.4,DA,0),U,3),EXST=$P(^(0),U,4),EXNAME=$S($D(^DVB(396.6,EXNAME,0)):$P(^(0),U,1),1:"") I EXST'["X",EXST'="T" D EXAMS1 ;screen cancels, transfers
51 Q
52 ;
53EXAMS1 I EXNAME]"" S DIE="^DVB(396.4,",DR=".08//NO;.09//CLINIC" W @IOF,!!!,"Exam: ",EXNAME,!!! D ^DIE Q:$D(Y)
54 Q
55 ;
56GO1 K TFIND F DVBAXJ=0:0 S DVBAXJ=$O(^DVB(396.4,"C",REQDA,DVBAXJ)) Q:DVBAXJ="" I $P(^DVB(396.4,DVBAXJ,0),U,4)'="T" S TFIND=1
57 Q
58 ;if $D(TFIND) at least one exam to be done locally
59 ;if '$D(TFIND) all exams are transferred/don't consider
Note: See TracBrowser for help on using the repository browser.