source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTNQ41.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: 1.9 KB
RevLine 
[613]1RTNQ41 ;MJK,PKE/TROY ISC;Expanded Record Inquiry cont; ; 9/4/90 9:57 AM ;
2 ;;v 2.0;Record Tracking;**19,20,21**;10/22/91
3 S DFN=+RTE,(R3,R2)=""
4 ;appointment
5 S (I,S)=0
6 F S S=$O(^DPT(DFN,"S",S)) Q:'S DO
7 .I $P(^DPT(DFN,"S",S,0),U,2)'["C" DO
8 ..S I=I+1,Z(I)=S
9 ..K Z(I-3)
10 N RTLPCT
11 S CT=0,RTLPCT=$O(Z(0))
12 I RTLPCT DO
13 .F S=RTLPCT:1:RTLPCT+2 DO
14 ..I $D(Z(S)),($D(^DPT(DFN,"S",Z(S),0))) DO
15 ...S Y=Z(S) D D^DIQ
16 ...S Y=$E($S($D(^SC(+^(0),0)):$P(^(0),"^"),1:"UNKNOWN"),1,19)_"^"_Y
17 ...S CT=CT+1
18 ...S R3(4-CT)=Y
19 K RTLPCT
20 ;admissions
21 D ADM^VADPT2 S Y=VADMVT
22 I +Y S CT=4,Y=^DGPM(VADMVT,0),M="adm" D ADM S M="dis",CT=5 D DIS Q
23 I Y="" S M="dis",CT=5 K RTAD D DIS Q:'$D(RTAD) S M="adm",Y=^DGPM(RTAD,0),CT=4 D ADM Q
24 Q
25Q K RTFUT,RTESC,RTE,RTFL,RTDTI,A1,A,S,RTVAR,RTPGM,RTDT,R,RT,M,P,DFN,RTG,RTH,RTI,T,V,^TMP($J,"RTCOMBO") D CLOSE^RTUTL
26 K RTG1,%,%H,%I,N,POP,RTI1 Q
27 ;
28REC S V=$S('$D(^DIC(195.2,+$P(Y,"^",3),0)):"UNKNOWN",1:$P(^(0),"^",2))_+$P(Y,"^",7) Q
29 ;
30ADM ;
31 S D1=+Y,D=9999999.9999-Y,Y=$S($D(^DIC(42,+$P(Y,"^",6),0)):$P(^(0),"^"),1:"UNKNOWN")_" ",R2(CT)=$E(Y,1,20)_";"_M,Y=$E(D1,1,12) D D^DIQ S R2(CT)=R2(CT)_"^"_Y
32 Q
33DIS ;
34 Q:'$D(^DGPM("ATID3",DFN)) D NOW^%DTC S Y=$O(^DGPM("ATID3",DFN,9999999.9999999-%)) Q:Y="" S Y=$O(^(Y,0)),DA=Y,Y=^DGPM(Y,0),RTY=Y,RTAD=$S($P(Y,U,14):$P(Y,U,14),1:0)
35 S DIC="^DGPM(",DR=200,DIQ(0)="E",DIQ="HLD($J," D EN^DIQ1 K DIC,DR S X=$S($D(HLD($J,405,DA,200,"E")):HLD($J,405,DA,200,"E"),1:0),X=X_" ",Y=RTY,R2(CT)=$E(X,1,20)_";"_M,Y=+Y D D^DIQ S R2(CT)=R2(CT)_"^"_Y
36 K RTY,HLD($J,405,DA),DA
37 Q
38 ;
39DPL ;Displays the admissions and discharges.
40 D LINE^RTUTL3
41 F CT=1:1:3 I $D(R3(CT)) W !,$P($T(LABELS+CT),";;",2)," ",$E($P(R3(CT),"^")_" ",1,20),$P(R3(CT),"^",2)
42XXX F CT=4:1:5 I $D(R2(CT)) W !,$P($T(LABELS+CT),";;",2)," ",$E($P(R2(CT),"^")_" ",1,20),$P(R2(CT),"^",2)
43 Q
44LABELS ;;
45 ;;Clinic appoint :
46 ;;Clinic appoint :
47 ;;Clinic appoint :
48 ;;Last Admission :
49 ;;Last Discharge :
Note: See TracBrowser for help on using the repository browser.