| 1 | RTQ3 ;MJK/TROY ISC;ADT Link; ; 5/21/87 3:21 PM ;
|
|---|
| 2 | ;;v 2.0;Record Tracking;;10/22/91
|
|---|
| 3 | ADM I $D(RTAPL) D SAVE^RTPSET1,NEXT,RESTORE^RTPSET1 Q
|
|---|
| 4 | NEXT Q:'$D(^DIC(195.4,1,"MAS")) S Y=+^("MAS") D APL1^RTPSET S IOP="" D ^%ZIS K IOP S Y=0
|
|---|
| 5 | I $D(^RTV(195.9,"ADEV",ION)),$D(^RTV(195.9,+$O(^(ION,0)),0)),$D(^SC(+$P(^(0),U,2),0)),$P(^(0),"^",3)="Z",$D(^DIC(40.9,+$P(^(0),"^",22),0)),$P(^(0),"^",2)="AA" S Y=+$P(^RTV(195.9,+$O(^RTV(195.9,"ADEV",ION,0)),0),U,2)
|
|---|
| 6 | I '$D(^SC(Y,0)) W ! S DIC("S")="I $P(^(0),U,3)=""Z"",$D(^DIC(40.9,+$P(^(0),U,22),0)),$P(^(0),U,2)=""AA""" S DIC("A")="Select Admitting Area: ",DIC(0)="IAEMQ",DIC="^SC(" D ^DIC K DIC G Q:Y<0
|
|---|
| 7 | I Y S SDSC=+Y D NOW^%DTC S SDTTM=%,SDPL=0 D NEW:$P(DGFC,"^",2),ASK,QUE^RTQ2:$E(X)="Y"
|
|---|
| 8 | Q K SDSC,SDTTM,SDPL,RTAPL Q
|
|---|
| 9 | ;
|
|---|
| 10 | ASK S RTRD(1)="YES^request records",RTRD(2)="NO^indicate no records to be requested",RTRD("A")="ISSUE REQUEST FOR RECORDS? ",RTRD(0)="S",RTRD("B")=1 D SET^RTRD K RTRD Q
|
|---|
| 11 | ;
|
|---|
| 12 | NEW S RTRD(1)="YES^print barcode labels",RTRD(2)="NO^do not print barcode labels",RTRD("B")=1,RTRD("A")="PRINT BARCODE LABELS FOR PATIENT'S FOLDERS? ",RTRD(0)="S" D SET^RTRD K RTRD Q:$E(X)'="Y"
|
|---|
| 13 | ;
|
|---|
| 14 | NOASK S RTADM="",RTE=DFN_";DPT(",RTA=+RTAPL,RTB=SDSC_";SC(",Y=+$O(^RTV(195.9,"ABOR",RTB,RTA,0)) D SET^RTDPA3:'Y S RTB=Y,RTFR=Y_"^"_$P(^RTV(195.9,Y,0),"^",2,99) S:$P(RTSYS,"^",4)="e" $P(RTFR,"^",4,6)="^^"
|
|---|
| 15 | S X="A" D SAVE S X=Y,A=RTA D INST1^RTUTL G NOASKQ:'$D(RTINST) S RTDIV=RTINST K RTINST
|
|---|
| 16 | F RTBLD=0:0 S RTBLD=$O(^RTV(195.9,RTB,"RECS",RTBLD)) Q:'RTBLD I $D(^(RTBLD,0)) S X=^(0) I $D(^DIC(195.2,+X,0)),$P(X,"^",2)]"",$P(X,"^",2)'="n" S RTTY=+X,RTAPL=+$P(X,"^",3) I '$D(^RT("AT",RTTY,RTE)) D TYPE1^RTDPA1
|
|---|
| 17 | NOASKQ S X="A" D RESTORE K RTSYS,RTDIV,RTA,RTB,RTFR,RTE,RTADM,RTBLD,RTTY,RTAPL Q
|
|---|
| 18 | ;
|
|---|
| 19 | SAVE K RTMASAVE X "I $D("_X_")#2 S RTMASAVE=@X" I @("$D("_X_")>9") S %X=X_"(",%Y="RTMASAVE(" D %XY^%RCR
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | RESTORE S:$D(RTMASAVE)#2 @X=RTMASAVE I $D(RTMASAVE)>9 S %X="RTMASAVE(",%Y=X_"(" D %XY^%RCR
|
|---|
| 23 | K RTMASAVE Q
|
|---|
