| 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  :
 | 
|---|