source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDPPDIS1.m@ 1397

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

initial load of FOIAVistA 6/30/08 version
File size: 3.5 KB
Line 
1SDPPDIS1 ;ALB/CAW - Patient Profile - Disposition ; 5/3/92
2 ;;5.3;Scheduling;**6**;Aug 13, 1993
3 ;
4 ;
5EN1 ;
6 N SDBEN,SDBENE,SDCAR,SDCARE,SDDIS,SDSC,SDSTAT,SDSTATUS,SDVER,SDYN,SDSTART,SDSTOP
7 S SDSTART=$S($D(SDBEG):9999999,1:9999999-SDBD),SDSTOP=$S($D(SDEND):0,1:9999999-SDED),SDFST=20,SDSEC=60,SDLEN=20
8 I SDSTOP'=0 S SDSTOP=SDSTOP-1
9 F SD=SDSTOP:0 S SD=$O(^DPT(DFN,"DIS",SD)) Q:'SD!(SD>(SDSTART+.9)) S SDDIS(0)=$G(^(SD,0)),SDDIS(2)=$G(^(2)),SDDIS(3)=$G(^(3)) D INFO
10 Q
11INFO ; Set up info for display
12 ;
13LOGIN ; Log In Date/Time and Log Out Date/Time
14 S X="",X=$$SETSTR^VALM1("Log In Date/Time:",X,2,17)
15 S X=$$SETSTR^VALM1($$FDTTM^VALM1(+SDDIS(0)),X,SDFST,SDLEN)
16 S X=$$SETSTR^VALM1("Log Out Date/Time:",X,41,18)
17 S X=$$SETSTR^VALM1($$FDTTM^VALM1($P(SDDIS(0),U,6)),X,SDSEC,SDLEN)
18 D SET(X)
19BENE ; Type of Benefit Applied For and Disposition
20 S X="",X=$$SETSTR^VALM1("Benefit Appl. For:",X,1,18)
21 S SDBEN=$P(SDDIS(0),U,3),SDBENE=$S(SDBEN=1:"HOSPITAL",SDBEN=2:"DOMICILIARY",SDBEN=3:"OUTPATIENT MEDICAL",SDBEN=4:"OUTPATIENT DENTAL",SDBEN=5:"NURSING HOME CARE",1:"UNKNOWN")
22 S X=$$SETSTR^VALM1(SDBENE,X,SDFST,SDLEN)
23 S X=$$SETSTR^VALM1("Disposition:",X,47,12)
24 S X=$$SETSTR^VALM1($P($G(^DIC(37,+$P(SDDIS(0),U,7),0)),U),X,SDSEC,SDLEN)
25 D SET(X)
26CARE ; Type of Care Applied For and Status
27 S X="",X=$$SETSTR^VALM1("Care Applied For:",X,2,17)
28 S SDCAR=$P(SDDIS(0),U,11),SDCARE=$S(SDCAR=1:"DENTAL",SDCAR=2:"PLASTIC SURGERY",SDCAR=3:"STERILIZATION",SDCAR=4:"PREGNANCY",SDCAR=5:"ALL OTHER",1:"UNKNOWN")
29 S X=$$SETSTR^VALM1(SDCARE,X,SDFST,SDLEN)
30 S X=$$SETSTR^VALM1("Status:",X,52,7)
31 S SDSTAT=$P(SDDIS(0),U,2),SDSTATUS=$S(SDSTAT=0:"10/10 VISIT",SDSTAT=1:"UNSCHEDULED",SDSTAT=2:"APPLICATION W/O EXAM",1:"UNKNOWN")
32 S X=$$SETSTR^VALM1(SDSTATUS,X,SDSEC,SDLEN)
33 D SET(X)
34FAC ; Facility Applying To and Amis 400 Series
35 S X="",X=$$SETSTR^VALM1("Fac. Applying To:",X,2,17)
36 S X=$$SETSTR^VALM1($P($G(^DG(40.8,+$P(SDDIS(0),U,4),0)),U),X,SDFST,SDLEN)
37 S X=$$SETSTR^VALM1("AMIS 420 Series:",X,43,16)
38 S X=$$SETSTR^VALM1($P(SDDIS(0),U,17),X,SDSEC,SDLEN)
39 D SET(X)
40REG ; Registration Eligiblity Code and Eligibility Verified at Registration
41 S X="",X=$$SETSTR^VALM1("Reg. Elig. Code:",X,3,16)
42 S X=$$SETSTR^VALM1($P($G(^DIC(8,+$P(SDDIS(0),U,13),0)),U),X,SDFST,SDLEN)
43 S X=$$SETSTR^VALM1("Elig Ver. at Reg.:",X,41,18)
44 S SDVER=$S($P(SDDIS(0),U,14)=0:"NO",$P(SDDIS(0),U,14)=1:"YES",1:"UNKNOWN")
45 S X=$$SETSTR^VALM1(SDVER,X,SDSEC,SDLEN)
46 D SET(X)
47WHOE ; Who entered 10/10 and SC at Registration
48 S X="",X=$$SETSTR^VALM1("Who entered 10/10:",X,1,18)
49 S X=$$SETSTR^VALM1($P($G(^VA(200,+$P(SDDIS(0),U,5),0)),U),X,SDFST,SDLEN)
50 S X=$$SETSTR^VALM1("SC at Reg.:",X,48,11)
51 S SDSC=$S($P(SDDIS(0),U,15)=0:"NO",$P(SDDIS(0),U,15)=1:"YES",1:"UNKNOWN")
52 S X=$$SETSTR^VALM1(SDSC,X,SDSEC,SDLEN)
53 D SET(X)
54WHOD ; Who dispositioned and SC % At Registration
55 S X="",X=$$SETSTR^VALM1("Who Dispositioned:",X,1,18)
56 S X=$$SETSTR^VALM1($P($G(^VA(200,+$P(SDDIS(0),U,9),0)),U),X,SDFST,SDLEN)
57 I $P(SDDIS(0),U,16)'="" D
58 .S X=$$SETSTR^VALM1("SC % At Reg.:",X,46,13)
59 .S X=$$SETSTR^VALM1($P(SDDIS(0),U,16)_"%",X,SDSEC,SDLEN)
60 D SET(X)
61ACTIVE ; Active (registration has not been dispositioned) and Reason Late Disp
62 S X=""
63 I $P(SDDIS(0),U,10)'="" D
64 .S X=$$SETSTR^VALM1("Active:",X,12,7)
65 .S X=$$SETSTR^VALM1("YES",X,SDFST,SDLEN)
66 I $P(SDDIS(0),U,8)'="" D
67 .S X=$$SETSTR^VALM1("Reason Late Disp.:",X,41,18)
68 .S X=$$SETSTR^VALM1($P($G(^DIC(30,$P(SDDIS(0),U,8),0)),U),X,SDSEC,SDLEN)
69 D:X'="" SET(X)
70 D ^SDPPDIS2 Q
71SET(X) ; Set in ^TMP global for display
72 ;
73 S SDLN=SDLN+1,^TMP("SDPPALL",$J,SDLN,0)=X
74 Q
Note: See TracBrowser for help on using the repository browser.