source: WorldVistAEHR/trunk/r/INCOMPLETE_RECORDS_TRACKING-DGJ/DGJTVW1.m@ 699

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

initial load of WorldVistAEHR

File size: 4.7 KB
Line 
1DGJTVW1 ;ALB/MAF - DISPLAY SCREENS FOR INCOMPLETE RECORDS TRACKING (LIST PROCESSOR) CONT. ; 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 D ^DGJTVW2
9 S RTE=DFN_";DPT(",RTYPE=$$RECTYP^DGJOPRT1(DGJTNO) D LATEST^RTUTL3
10 S X=""
11 S DGJVAL=" "_$S('$D(^XUSEC("DGJ TS UPDATE",DUZ))&($P(DGJTNO,"^",2)=$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)))&('$D(DGJTVIEW)):"*",1:" ")_"Specialty: "
12 S X=$$SETSTR^VALM1(DGJVAL,X,1,22)
13 S DGJVAL=$P(DGJTNO,"^",7) S DGJVAL=$S($D(^DIC(45.7,+DGJVAL,0)):$P(^(0),"^"),1:"")
14 S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
15 S DGJVAL=$P(RTDATA,"^",2)
16 S X=$$SETSTR^VALM1($S($D(DGJTVIEW):" Borrower: ",1:" *Borrower: "),X,42,21)
17 S X=$$SETSTR^VALM1(DGJVAL,X,63,18) D TMP^DGJTVW2
18 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: "
19 S X=""
20 S X=$$SETSTR^VALM1(DGJVAL,X,1,22)
21 S DGJVAL=$P(DGJTNO,"^",9) S DGJVAL=$S($D(^VA(200,+DGJVAL,0)):$P(^(0),"^"),1:"")
22 S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
23 S DGJVAL=$P(RTDATA,"^",3)
24 S X=$$SETSTR^VALM1($S($D(DGJTVIEW):" Phone/Rm: ",1:" *Phone/Rm: "),X,42,21)
25 S X=$$SETSTR^VALM1(DGJVAL,X,63,18) D TMP^DGJTVW2
26 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: "
27 S X=""
28 I $P(DGJTDEL,"^",3)=1!($P(DGJTDEL,"^",3)=0&($P(DGJTDEL,"^",10)="A")) S X=$$SETSTR^VALM1(DGJVAL,X,1,22)
29 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:"")
30 I $P(DGJTDEL,"^",3)=1!($P(DGJTDEL,"^",3)=0&($P(DGJTDEL,"^",10)="A")) S X=$$SETSTR^VALM1(DGJVAL,X,23,18)
31 S DGJVAL=$P(RTDATA,"^",4),Y=DGJVAL I DGJVAL]"" X ^DD("DD") S DGJVAL=Y
32 S X=$$SETSTR^VALM1($S($D(DGJTVIEW):" Date Charged: ",1:" *Date Charged: "),X,42,21)
33 S X=$$SETSTR^VALM1(DGJVAL,X,63,18) D TMP^DGJTVW2
34 K RTDATA,RTE,RTYPE
35 D CODDT^DGJTVW,CODBY^DGJTVW
36 I '$D(^VAS(393,$P(DGJTEDT,"^",2),"MSG")) S X="",X=$$SETSTR^VALM1("4)",X,1,2) D TMP^DGJTVW2 S X="",X=$$SETSTR^VALM1("Comments:",X,1,9) D TMP^DGJTVW2 G STAT
37 D COM^DGJTVW
38STAT S:'$D(DGJTVIEW) X="",X=$$SETSTR^VALM1("* For display only!",X,1,19) D:'$D(DGJTVIEW) TMP^DGJTVW2
39 D STAT1^DGJTVW
40 K DGJTSF
41 I $D(DGJTVIEW) K DGJTVIEW Q
42 Q
43REDSP S VALMBCK="R" D EN Q
44ALLEDIT ;Edit all 4 groups
45 I $P(DGJTNO,"^",2)'=$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)) F DGJTNUM=1:1:4 S:DGJTNUM=3 X=3 D EDIT Q:'$D(DGJTUP)!(X="^")!($D(DTOUT)) K DGJTUP
46 I $P(DGJTNO,"^",2)=$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)) F DGJTNUM=1,3,4,2 S:DGJTNUM=3 X=3 D EDIT Q:'$D(DGJTUP)!(X="^")!($D(DTOUT)) K DGJTUP
47 Q
48EDIT ;EDIT
49 D FULL^VALM1
50 I DGJTNUM["2",$P(DGJTNO,"^",2)=$O(^VAS(393.3,"B","DISCHARGE SUMMARY",0)) D CK,EN S VALMBCK="R" Q
51 D EDIT1
52 D:'$D(DGJTDEF) EN D:$D(DGJTDEF) ^DGJTVW3 S VALMBCK="R" Q
53QUIT1 K %,D,DA,D0,DIE,DR,VA,DGJT1,DGJTCL,DGJTEDT,DGJTHDR,DGJTNDT,DGJTNM,DGJTNO,DGJTNST,DGJTNUM,DGJTNUM1,DGJTPTID,DGJTRC,DGJTUP,DGJTXX,DGJX,DGX,DGJTYPX,Y,^TMP("DGJRPT",$J),^TMP("RPTIDX",$J) Q
54DISTS S DGPMT=6,DGPMCA=$P(DGJTNO,"^",4) D CA^DGPMV S:Y]"" DGJTUP=1 Q:$D(DGJTSEDT) D STAT1^DGJTVW Q
55CK S DGJTNUM1=DGJTNUM I DGJTNUM["1" S DGJTNUM=1 D EDIT1 S DGJTNUM=DGJTNUM1 Q:'$D(DGJTUP) K DGJTUP
56 I '$D(^XUSEC("DGJ TS UPDATE",DUZ)) W !!,"A security key must be issued to edit data in item 2." R !!,"Hit return to continue ",X:DTIME Q:X="^"!('$T) G CK1
57 S DGJT1=2 D 1^DGJTVW
58 I DGJVAL]"" S Y=X X ^DD("DD") W !!,"PTF Record was closed on "_Y_" for patient.... You Must",!,"reopen the record before you can enter any changes for group 2",! S DGJTNUM1=DGJTNUM R !!,"Hit return to continue ",X:DTIME Q:X="^"!('$T) G CK1
59 I DGJTNUM1[2 D MESS S DGJTNUM=2 D DISTS S DGJTNUM=DGJTNUM1 Q:'$D(DGJTUP)
60CK1 I DGJTNUM1[3 S DGJTNUM=3 D EDIT1 Q:'$D(DGJTUP) K DGJTUP
61 S DGJTNUM=DGJTNUM1 I DGJTNUM1[4 S DGJTNUM=4 D EDIT1 S DGJTNUM=DGJTNUM1
62 Q
63EDIT1 S DIE="^VAS(393,",DA=$P(DGJTEDT,"^",2),DR="[DGJ EDIT IRT RECORD]" D ^DIE K DR,DIC("S")
64 K DR Q
65MESS W !!?3,"When editing this section you must edit/create a new Treating Specialty"
66 W !,"Entering '^' at any prompt will exit you out of the "
67 W "treating Specialty edit only"
Note: See TracBrowser for help on using the repository browser.