source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTQ3.m@ 1766

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

initial load of WorldVistAEHR

File size: 1.9 KB
Line 
1RTQ3 ;MJK/TROY ISC;ADT Link; ; 5/21/87 3:21 PM ;
2 ;;v 2.0;Record Tracking;;10/22/91
3ADM I $D(RTAPL) D SAVE^RTPSET1,NEXT,RESTORE^RTPSET1 Q
4NEXT 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"
8Q K SDSC,SDTTM,SDPL,RTAPL Q
9 ;
10ASK 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 ;
12NEW 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 ;
14NOASK 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
17NOASKQ S X="A" D RESTORE K RTSYS,RTDIV,RTA,RTB,RTFR,RTE,RTADM,RTBLD,RTTY,RTAPL Q
18 ;
19SAVE 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 ;
22RESTORE S:$D(RTMASAVE)#2 @X=RTMASAVE I $D(RTMASAVE)>9 S %X="RTMASAVE(",%Y=X_"(" D %XY^%RCR
23 K RTMASAVE Q
Note: See TracBrowser for help on using the repository browser.