source: WorldVistAEHR/trunk/r/AUTOMATED_MED_INFO_EXCHANGE-DVBA-DVBC/DVBAAPLK.m@ 1177

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

initial load of WorldVistAEHR

File size: 2.4 KB
RevLine 
[613]1DVBAAPLK ;ALB/GTS-557/THM-FORMATTING ROUTINE FOR APPTS (DVBAREN1) ;21 JUL 89
2 ;;2.7;AMIE;;Apr 10, 1995
3 S XDD=^DD("DD")
4 ;
5EN1 W @IOF,!,"Non-admitted Veteran Date Selection",!
6 S DISTYPE="" W !!,?5,"Select from:",!!,?10,"(A)ppointment date",!
7 W ?10,"(D)isposition log-in date",!
8 W ?10,"(S)top code",!!
9 W !,"Enter selection: A// " R DISTYPE:DTIME I '$T S Y=-1,AROWOUT=1,DVBAQUIT=1 Q
10 I DISTYPE["?" G CHECK
11 I DISTYPE="" S DISTYPE="A"
12 I DISTYPE=U S Y=-1,AROWOUT=1 Q
13 I DISTYPE'?1"A"&(DISTYPE'?1"D")&(DISTYPE'?1"S") W !!,*7,"Must be A, D, or S",!! H 2 G EN1
14 W @IOF,!,$S(DISTYPE="A":"Appointment",DISTYPE="D":"Disposition Log-in",1:"Stop code")_" Date Selection for "_PNAM,!!!
15 D @DISTYPE K APPT,DISTYPE,K,ANS,^TMP("DVBA",$J),ANS1,DIC,I,J,X
16 Q
17 ;
18A S Y=-1 I '$D(^DPT(DFN,"S")) W !!,*7,"This veteran has no appointments on file.",!! S OUT=1 H 2 Q
19 W !!,"Choose from these appointment dates: " W !!
20 S ANS="" S K=0 F I=0:0 S I=$O(^DPT(DFN,"S",I)) Q:I="" S J=$P(^(I,0),"^",1) S Y=I X XDD S K=K+1 S ^TMP("DVBA",$J,K)=I D WRITE
21 I ANS="" D SELECT
22 I ANS="" S OUT=1 Q
23 I ANS]"",ANS'="^" S Y=^TMP("DVBA",$J,ANS) K ^TMP("DVBA",$J)
24 I ANS="^"!(ANS']"") S AROWOUT=1,Y=-1 K APPT Q
25 S APPDT=$P(Y,".",1),Y=-1
26 Q
27WRITE W ?5,K_". ",?10,$P(Y,"@",1),?25,$P(Y,"@",2,99),?35,$S($D(^SC(J,0)):$P(^SC(J,0),U,1),1:"Unknown clinic"),! I $Y#11=0 D SELECT W !! S:ANS]"" I=9999999.999 Q:ANS]""
28 Q
29SELECT S ANS="" W !,"Select 1 to "_K_",",!," [RETURN] to continue to search,",!," OR ""^"" to QUIT. " R ANS:DTIME Q:ANS=U!(ANS="")!('$T)
30 I ANS'?1.3N!(ANS<1)!(ANS>K) W !!,*7,"Must be between 1 and "_K_" ,RETURN, or ""^""",!! H 2 G SELECT
31 Q
32 ;
33D I '$D(^DPT(DFN,"DIS")) W !!,*7,"This veteran has no log-ins on file.",!! H 2 S Y=-1,OUT=1 Q
34 S DIC="^DPT(DFN,""DIS"",",DIC(0)="AEQM",DIC("A")="Enter Disposition Log-in time: " D ^DIC I X=""!(X=U) S Y=-1,AROWOUT=1 Q
35 S APPDT=$E($P(Y,U,2),1,7),Y=-1
36 Q
37 ;
38S I '$D(^SDV("ADT",DFN)) W !!,*7,"This veteran has no stop codes on file.",!! H 2 S OUT=1,Y=-1 Q
39 S DIC="^SDV(",DIC(0)="EQM",X=$P(^DPT(DFN,0),U,9) D ^DIC I Y=-1 S OUT=1 Q
40 S APPDT=$E($P(Y,U,2),1,7),Y=-1
41 Q
42 ;
43CHECK ;check what choices are available
44 W @IOF,!!,"The following choices are available for this Veteran:",!!
45 I $D(^DPT(DFN,"S")) W "Appointments",!
46 I $D(^SDV("ADT",DFN)) W "Stop codes",!
47 I $D(^DPT(DFN,"DIS")) W "Disposition Log-in dates",!
48 W !!,"Press [RETURN] to continue or ""^"" to quit " R ANS1:DTIME S:ANS1=U AROWOUT=1 Q:ANS1=U I '$T S DVBAQUIT=1 Q
49 G EN1
Note: See TracBrowser for help on using the repository browser.