| [613] | 1 | RTNQ41 ;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
|
|---|
| 25 | Q 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 | ;
|
|---|
| 28 | REC S V=$S('$D(^DIC(195.2,+$P(Y,"^",3),0)):"UNKNOWN",1:$P(^(0),"^",2))_+$P(Y,"^",7) Q
|
|---|
| 29 | ;
|
|---|
| 30 | ADM ;
|
|---|
| 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
|
|---|
| 33 | DIS ;
|
|---|
| 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 | ;
|
|---|
| 39 | DPL ;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)
|
|---|
| 42 | XXX 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
|
|---|
| 44 | LABELS ;;
|
|---|
| 45 | ;;Clinic appoint :
|
|---|
| 46 | ;;Clinic appoint :
|
|---|
| 47 | ;;Clinic appoint :
|
|---|
| 48 | ;;Last Admission :
|
|---|
| 49 | ;;Last Discharge :
|
|---|
