source: WorldVistAEHR/trunk/r/RECORD_TRACKING-RT/RTP41.m@ 701

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

initial load of WorldVistAEHR

File size: 3.2 KB
Line 
1RTP41 ;MJK/TROY ISC;Charge Out Pull List (continued); ; 4/24/87 11:55 AM ;
2 ;;v 2.0;Record Tracking;;10/22/91
3 ;
4LIST W !!!,$S(RTLIST="RTCANCEL":"Cancelled Requests",1:"Missing Records")," List" D NOW^%DTC S Y=$E(%,1,12) D D^DIQ W ?55,"RUN DATE: ",Y
5 W !!,"PULL LIST",?25,"REQUEST#",?35,"REQUESTED TIME",?60,"RECORD INFORMATION" D EQUALS^RTUTL3
6 S RTPX="" F RTPX1=0:0 S RTPX=$O(^TMP($J,RTLIST,RTPX)) Q:RTPX="" F RTQ=0:0 S RTQ=$O(^TMP($J,RTLIST,RTPX,RTQ)) Q:'RTQ S RTQ0=^(RTQ) D WRITE
7 K RTPX,RTPX1,RTQ,RTQ0 Q
8 ;
9WRITE S RT=+RTQ0 Q:'$D(^RT(+RT,0)) S RT0=^(0),RTYPE=$S($D(^DIC(195.2,+$P(RT0,"^",3),0)):$P(^(0),"^",2),1:"???")_+$P(RT0,"^",7),Y=+$P(RTQ0,"^",4) D D^DIQ S RTQDT=Y,Y=$P(RT0,"^") D NAME^RTB S RTNME=Y
10 S RTSSN="" I $P(RT0,"^")[";DPT(",$D(^DPT(+RT0,0)) S X=$P(^(0),"^",9),RTSSN=$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10)
11 W !?2,$E(RTPX,1,20),?25,RTQ,?35,RTQDT,?60,RTYPE,?65,$E(RTNME,1,15),!,?60,RT,?65,RTSSN D LINE^RTUTL3
12 K RT,RT0,RTNME,RTQDT,RTYPE Q
13 ;
14SHOW ;
15 W !!,"The following CLINIC pull lists will be ",RTMES,": " S RTEND=RTDT_".9999",RTC=0
16 F D=(RTDT-.0001):0 S D=$O(^RTV(194.2,"C",D)) Q:'D!(D>RTEND) F P=0:0 S P=$O(^RTV(194.2,"C",D,P)) Q:'P I $D(^RTV(194.2,P,0)) S X=^(0) I $P(X,"^",10)=1,$P(X,"^",15)=+RTAPL,$P(X,"^",6)'="x",$P(X,"^",12) S RTC=RTC+1 D SHOW1
17 I 'RTC W !?5,*7,"No CLINIC pull lists need to be ",RTMES,"."
18 K RTEND,P,D Q
19 ;
20SHOW1 S SAVX=X I RTC#10=0 S DIR(0)="E" D ^DIR I X="^" S D=9999999 Q
21 S X=SAVX W !?5,RTC,". ",$E($P($P(X,"^"),"["),1,25),?35," Status: " S C=$P(^DD(194.2,6,0),"^",2),Y=$P(X,"^",6) D Y^DIQ W Y Q
22 ;
23BOR ;ask record retirement borrower
24 ;return rtb, rtyes, rtaccn
25 S A=+RTAPL,DIC("B")=$S($D(^DIC(195.1,+RTAPL,4)):$P(^(4),"^",4),1:"")
26 D DIC^RTDPA31 S DIC="^RTV(195.9,",DIC("A")="Select Record Retirement Borrower: ",DIC(0)="IAEMQ",DIC("S")="S Z0=^(0),Z=$P($P(Z0,U),"";"",2) I Z=""DIC(4,"",$P(Z0,U,3)="_+RTAPL_" D DICS1^RTDPA31" W ! D ^DIC Q:Y<0 S RTB=+Y
27 ;
28 W ! S DIR(0)="YO",DIR("B")="Yes" D H13 S DIR("A")="Do you want to create "_$S($T:"'"_Y_"'",1:"Perpetual")_" records from Pull list",DIR("?")="^D H1^RTP41",DIR("??")="^D H12^RTP41" D ^DIR K DIR S RTYES=Y
29 Q:'RTYES
30 I RTYES D H13 I '$T D H14 H 3 S RTYES="^"
31 ;
32 W ! S DIR(0)="FO^3:20",DIR("A")="Enter the Record Center's accession number for these records",DIR("?")="^D H4^RTP41",DIR("??")="^D H42^RTP41" D ^DIR K DIR S RTACCN=Y
33 Q
34 ;
35H1 W !!?5,"Answer 'Yes' to create the default perpetual record."
36 W !?5,"Answer 'No' to just charge out the retirement pull list." Q
37H12 W !!?5,"After the Pull list(s) are charged out, a perpetual record"
38 W !?5,"can be created for each patient on the Pull list."
39 D H13 I $T W !?5,"'",Y,"' records and labels will be created" Q
40H14 W !?5,"The application default perpetual record is NOT defined."
41 W !?14,"NO records will be created" Q
42H13 I $D(^DIC(195.1,+RTAPL,4)),$P(^(4),"^",5) S Y=$P(^(4),"^",5),C=$P(^DD(195.1,45,0),"^",2) D Y^DIQ IF 1
43 Q
44H4 W !!?5,"The accession number will be recorded in the content descriptor"
45 W !?5,"field of the perpetual records created from these pull lists." Q
46H42 W !!?5,"Enter the accession number as provided by the Record Center."
47 W !?20,"from 3-20 characters"
48 W !!?5,"The accession numbers will be used in the future to locate"
49 W !?5,"records transfered to the Record Center." Q
Note: See TracBrowser for help on using the repository browser.