source: WorldVistAEHR/trunk/r/INCOMPLETE_RECORDS_TRACKING-DGJ/DGJTVW3.m@ 1800

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

initial load of WorldVistAEHR
File size: 4.8 KB
Line 
1DGJTVW3 ;ALB/MAF - DISPLAY SCREENS FOR DEFICIENCIES (LIST PROCESSOR) ; SEP 31,1992@900
2 ;;1.0;Incomplete Records Tracking;;Jun 25, 2001
3EN Q:'$D(^VAS(393,+$P(DGJTEDT,"^",2),0)) S DGJTNO=^VAS(393,$P(DGJTEDT,"^",2),0),DFN=+DGJTNO
4 I $D(^VAS(393,$P(DGJTEDT,"^",2),"DT")) S DGJTNDT=^VAS(393,$P(DGJTEDT,"^",2),"DT")
5 I '$D(^VAS(393,$P(DGJTEDT,"^",2),"DT")) S DGJTNDT="^^^^^^^^^^"
6 S X=$P(^VAS(393,$P(DGJTEDT,"^",2),0),"^",6) S DGJTDEL=$S($D(^DG(40.8,+X,"DT")):^("DT"),1:DGJTDEL)
7 S DGJTFL=0,DGJTHDR="INCOMPLETE RECORDS TRACKING "_$S($D(DGJTVIEW):"<View>",1:"<Edit>"),$P(DGJTCL,"=",81)="",DGJTNM=$P(^DPT(+DGJTNO,0),"^",1) D PID^VADPT6 S DGJTPTID=VA("PID") K VA
8 S RTE=DFN_";DPT(",RTYPE=$$RECTYP^DGJOPRT1(DGJTNO) D LATEST^RTUTL3
9 K ^TMP("DGJRPT",$J)
10 S X="",(VALMCNT,DGJCNT)=0,VALMBG=1
11 S X=$$SETSTR^VALM1(DGJTHDR,X,25,$L(DGJTHDR)) D TMP
12 S X=""
13 S X=$$SETSTR^VALM1("1)",X,1,2)
14 S X=$$SETSTR^VALM1("2)",X,42,2) D TMP
15 S X=""
16 S DGJVAL=$P(DGJTNO,"^",2) S DGJVAL=$S($D(^VAS(393.3,+DGJVAL,0)):$P(^VAS(393.3,+DGJVAL,0),"^",1),1:"")
17 S X=$$SETSTR^VALM1(" *Type of Deficiency: ",X,1,22)
18 S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
19 S DGJVAL=" "_$S('$D(^XUSEC("DGJ TS UPDATE",DUZ))&($P(DGJTNO,"^",2)=$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)))&('$D(DGJTVIEW)):"*",1:" ")_"Specialty: "
20 S X=$$SETSTR^VALM1(DGJVAL,X,42,21)
21 S DGJVAL=$P(DGJTNO,"^",7) S DGJVAL=$S($D(^DIC(45.7,+DGJVAL,0)):$P(^(0),"^"),1:"")
22 S X=$$SETSTR^VALM1(DGJVAL,X,64,17) D TMP
23 S X=""
24 S DGJVAL=" "_$S($P(DGJTNO,"^",2)=1&('$D(DGJTVIEW)):"*",1:" ")_"Event Date: "
25 S X=$$SETSTR^VALM1(DGJVAL,X,1,22)
26 S DGJVAL=$P(DGJTNO,"^",3),Y=DGJVAL I DGJVAL]"" X ^DD("DD") S DGJVAL=Y
27 S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
28 S DGJVAL=" "_$S('$D(^XUSEC("DGJ TS UPDATE",DUZ))&($P(DGJTNO,"^",2)=$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)))&('$D(DGJTVIEW)):"*",1:" ")_"Primary Physician: "
29 S X=$$SETSTR^VALM1(DGJVAL,X,42,21)
30 S DGJVAL=$P(DGJTNO,"^",9) S DGJVAL=$S($D(^VA(200,+DGJVAL,0)):$P(^(0),"^"),1:"")
31 S X=$$SETSTR^VALM1(DGJVAL,X,64,17) D TMP
32 S X="",DGJVAL=" "_$S('$D(DGJTVIEW):"*",1:"")_"Admission: "
33 S X=$$SETSTR^VALM1(DGJVAL,X,1,22)
34 I $P(DGJTNO,"^",4)]"" S DGJVAL=$P(DGJTNO,"^",4) S Y=$S($D(^DGPM(+DGJVAL,0)):+^DGPM(DGJVAL,0),1:"") X ^DD("DD") S DGJVAL=Y
35 I $P(DGJTNO,"^",4)']"" S DGJVAL="OUTPATIENT"
36 S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
37 I $P(DGJTDEL,"^",3)=1!($P(DGJTDEL,"^",3)=0&($P(DGJTDEL,"^",10)="A")) S DGJVAL=$S('$D(^XUSEC("DGJ TS UPDATE",DUZ))&($P(DGJTNO,"^",2)=$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)))&('$D(DGJTVIEW)):"*",1:" ")_"Attending Physician: "
38 I $P(DGJTDEL,"^",3)=1!($P(DGJTDEL,"^",3)=0&($P(DGJTDEL,"^",10)="A")) S X=$$SETSTR^VALM1(DGJVAL,X,42,21)
39 I $P(DGJTDEL,"^",3)=1!($P(DGJTDEL,"^",3)=0&($P(DGJTDEL,"^",10)="A")) S DGJVAL=$P(DGJTNO,"^",10) S DGJVAL=$S($D(^VA(200,+DGJVAL,0)):$P(^(0),"^"),1:"")
40 I $P(DGJTDEL,"^",3)=1!($P(DGJTDEL,"^",3)=0&($P(DGJTDEL,"^",10)="A")) S X=$$SETSTR^VALM1(DGJVAL,X,64,17) D TMP
41 S X=""
42 S X=$$SETSTR^VALM1(" *Division: ",X,1,22)
43 S DGJVAL=$P(DGJTNO,"^",6) S DGJVAL=$S($D(^DG(40.8,+DGJVAL,0)):$P(^(0),"^",1),1:"")
44 S X=$$SETSTR^VALM1(DGJVAL,X,23,18) D TMP
45 S DGJVAL=$P(DGJTNO,"^",5) S DGJVAL=$S($D(^SC(+DGJVAL,0)):$P(^(0),"^"),1:"")
46 S DGJVAL=" "_$S($P(DGJTNO,"^",2)=1&('$D(DGJTVIEW)):"*",1:" ")_"Location: "
47 S X=""
48 S X=$$SETSTR^VALM1(DGJVAL,X,1,22)
49 S DGJVAL=$P(DGJTNO,"^",5) S DGJVAL=$S($D(^SC(+DGJVAL,0)):$P(^(0),"^"),1:"")
50 S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
51 S DGJVAL=$P(RTDATA,"^",2)
52 S X=$$SETSTR^VALM1(" *Borrower: ",X,42,21)
53 S X=$$SETSTR^VALM1(DGJVAL,X,63,18) D TMP
54 S DGJVAL=$P(DGJTNO,"^",8)
55 S DGJVAL=$S($D(^DG(393.1,+DGJVAL,0)):$P(^(0),"^",1),1:"")
56 S X=""
57 S X=$$SETSTR^VALM1(" *Service: ",X,1,22)
58 S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
59 S DGJVAL=$P(RTDATA,"^",3)
60 S X=$$SETSTR^VALM1(" *Phone/Rm: ",X,42,21)
61 S X=$$SETSTR^VALM1(DGJVAL,X,63,18) D TMP
62 S X=""
63 S X=$$SETSTR^VALM1(" Phys. Responsible: ",X,1,22)
64 S DGJVAL=$P(DGJTNO,"^",12) S DGJVAL=$S($D(^VA(200,+DGJVAL,0)):$P(^(0),"^"),1:"")
65 S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
66 S DGJVAL=$P(RTDATA,"^",4),Y=DGJVAL I DGJVAL]"" X ^DD("DD") S DGJVAL=Y
67 S X=$$SETSTR^VALM1(" *Date Charged: ",X,42,21)
68 S X=$$SETSTR^VALM1(DGJVAL,X,63,18) D TMP
69 K RTE,RTYPE,RTDATA
70 D CODDT^DGJTVW,CODBY^DGJTVW
71 S X=""
72 S X=$$SETSTR^VALM1("3)",X,1,2) D TMP
73 S X=""
74 S X=$$SETSTR^VALM1(" Status: ",X,1,22)
75 S DGJVAL=$P(DGJTNO,"^",11) S DGJVAL=$S($D(^DG(393.2,+DGJVAL,0)):$P(^DG(393.2,DGJVAL,0),"^",1),1:"NOT SPECIFIED")
76 S X=$$SETSTR^VALM1(DGJVAL,X,23,18) D TMP
77 I '$D(^VAS(393,$P(DGJTEDT,"^",2),"MSG")) S X="",X=$$SETSTR^VALM1("4)",X,1,2) D TMP S X="",X=$$SETSTR^VALM1("Comments:",X,1,9) D TMP,DISP Q
78 D COM^DGJTVW
79DISP S:'$D(DGJTVIEW) X="",X=$$SETSTR^VALM1("* For display only!",X,1,19) D:'$D(DGJTVIEW) TMP Q
80TMP S DGJCNT=DGJCNT+1,VALMCNT=VALMCNT+1
81 S ^TMP("DGJRPT",$J,DGJCNT,0)=X,^TMP("DGJRPT",$J,"IDX",VALMCNT,DGJCNT)=""
82 S ^TMP("RPTIDX",$J,DGJCNT)=VALMCNT
83 Q
Note: See TracBrowser for help on using the repository browser.