source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAORD4.m@ 810

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

initial load of FOIAVistA 6/30/08 version
File size: 4.4 KB
Line 
1RAORD4 ;HISC/CAH,FPT,GJC AISC/RMO-Print Requests by Date ;2/3/98 06:50
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3 ;Call RAPSET1 to establish RAMDV
4 D SET^RAPSET1 I $D(XQUIT) K XQUIT Q
5 K RALOC I $P(RAMDV,"^",21) D ASKLOC G Q:'$D(RALOC)
6 W !!,"Request Status Selection",!,"------------------------" S RARD("A")="Select Status: "
7 S RARD(1)="Discontinued^print discontinued requests.",RARD(2)="Complete^print completed requests.",RARD(3)="Hold^print requests on hold."
8 S RARD(4)="Pending^print pending requests.",RARD(5)="Request Active^print active requests.",RARD(6)="Scheduled^print scheduled requests."
9 S RARD(7)="All Current Orders^print hold, pending, active and scheduled requests.",RARD("B")=4
10 D SET^RARD K RARD G Q:X["^" S RAOASTS=$S($E(X)="D":"1",$E(X)="C":"2",$E(X)="H":"3",$E(X)="P":"5",$E(X)="R":"6",$E(X)="S":"8",$E(X)="A":"3;5;6;8",1:"") G Q:RAOASTS=""
11 ;Based on whether user wants requests included based on Date Entered (fld 16) or Date Desired (fld 21), set RACRIT to correct piece # of Rad Order rec
12 W !!!,"Date Criteria Selection",!,"-----------------------"
13 K DIR S DIR(0)="S^E:ENTRY DATE OF REQUEST;D:DESIRED DATE FOR EXAM",DIR("A")="Date criteria to use for choosing requests to print",DIR("B")="E" D ^DIR G Q:$D(DTOUT)!($D(DUOUT)) S RACRIT=$S(Y="D":21,1:16) ;ch
14 S RASKTIME="" S RADDT=1 D DATE1^RAUTL K RADDT,RASKTIME G Q:RAPOP
15 D HS G Q:$D(DIRUT)
16 S ZTRTN="START^RAORD4",ZTSAVE("BEGDATE")="",ZTSAVE("ENDDATE")="",ZTSAVE("RAOASTS")="",ZTSAVE("RAHS")="",ZTSAVE("RACRIT")="" S:$D(RALOC) ZTSAVE("RALOC")=""
17 S:$D(RAOPT) ZTSAVE("RAOPT(")=""
18 W ! D ZIS^RAUTL G:RAPOP Q
19 ;
20START ; Start printing process
21 U IO K ^TMP($J,"RAHS"),^TMP($J,"RAORD4")
22 S RABEGDT=$S($P(BEGDATE,".",2):BEGDATE,1:BEGDATE-.0001),RAENDDT=$S($P(ENDDATE,".",2):ENDDATE,1:ENDDATE+.9999)
23 F RADFN=0:0 S RADFN=$O(^RAO(75.1,"AS",RADFN)) Q:'RADFN F RALP=1:1 S RAOSTS=$P(RAOASTS,";",RALP) Q:RAOSTS="" D CHKORD
24 I '$D(^TMP($J,"RAORD4")) D G Q
25 . W:$Y>0 @IOF
26 . W !?5,"There are no Requests for the selected Date Range."
27 . Q
28 S (RALNM,RAX)="",RAPGE=0 F RAILP=0:0 S RALNM=$O(^TMP($J,"RAORD4",RALNM)) Q:RALNM=""!(RAX["^") F RAOURG=0:0 S RAOURG=$O(^TMP($J,"RAORD4",RALNM,RAOURG)) Q:'RAOURG!(RAX["^") D CHKSTA
29 ;
30Q K BEGDATE,D,DN,DIROUT,DIRUT,DTOUT,DUOUT,ENDDATE,GMTSTYP,POP,RAPOP,RABEGDT,RACRIT,RADFN,RADTI,RACNI,RAENDDT,RAHS,RALIFN,RALNM,RALOC,RALP,RAOASTS,RAODTE,RAOIFN,RAOURG,RAPGE,RAX,DIC,RAILP,RAORD0,RAOSTS,VAERR,VAIN
31 K ^TMP($J,"RAHS"),^TMP($J,"RAORD4")
32 K RAMES,X,X1,Y,J,Z,ZTDESC,ZTRTN,ZTSAVE
33 W ! D CLOSE^RAUTL
34 D Q^RAORD5
35 K C,DFN,DIC,DIR,DISYS,DIW,DIWT,D0,POP
36 Q
37 ;
38 ;;The following code is used to SET-UP the utility global
39CHKORD F RAOIFN=0:0 S RAOIFN=$O(^RAO(75.1,"AS",RADFN,RAOSTS,RAOIFN)) Q:'RAOIFN I $D(^RAO(75.1,RAOIFN,0)) S RAORD0=^(0),RAODTE=+$P(RAORD0,"^",RACRIT) I RAODTE>RABEGDT,RAODTE<RAENDDT D CHKLOC:$D(RALOC),SETUTL:'$D(RALOC)
40 Q
41 ;
42CHKLOC I RALOC="ALL"!(RALOC=+$P(RAORD0,"^",20)) S RALIFN=+$P(RAORD0,"^",20),RALNM=$S('$D(^RA(79.1,RALIFN,0)):"UNKNOWN",$D(^SC(+^(0),0)):$P(^(0),"^"),1:"UNKNOWN") D SETUTL
43 Q
44 ;
45SETUTL S ^TMP($J,"RAORD4",$S($D(RALNM):RALNM,1:"L"),$S($P(RAORD0,"^",6):$P(RAORD0,"^",6),1:9),RAOSTS,RAODTE,RAOIFN)=RAORD0
46 Q
47 ;
48ASKLOC R !!,"Select IMAGING LOCATION: ",X:DTIME Q:'$T!(X="^")!(X="") I $E(X,1,3)="ALL"!($E(X,1,3)="all") S RALOC="ALL" Q
49 S DIC="^RA(79.1,",DIC(0)="EMQ" D ^DIC I Y>0 S RALOC=+Y Q
50 W:X'["?" *7 W !!?3,"Enter 'ALL' or select an Imaging Location to print pending requests." G ASKLOC
51 ;
52 ;;The following code is used to PRINT the utility global
53CHKSTA F RAOSTS=0:0 S RAOSTS=$O(^TMP($J,"RAORD4",RALNM,RAOURG,RAOSTS)) Q:'RAOSTS!(RAX["^") D CHKDTE
54 Q
55 ;
56CHKDTE F RAODTE=0:0 S RAODTE=$O(^TMP($J,"RAORD4",RALNM,RAOURG,RAOSTS,RAODTE)) Q:'RAODTE!(RAX["^") D CHKUTL
57 Q
58 ;
59CHKUTL ; Print Health Summary if applicable
60 N RA751 S RAOIFN=0
61 F S RAOIFN=$O(^TMP($J,"RAORD4",RALNM,RAOURG,RAOSTS,RAODTE,RAOIFN)) Q:'RAOIFN!(RAX["^") D
62 . S RADFN=+$G(^TMP($J,"RAORD4",RALNM,RAOURG,RAOSTS,RAODTE,RAOIFN))
63 . S RA751(0)=$G(^RAO(75.1,RAOIFN,0)),RA751(2)=$P(RA751(0),"^",2)
64 . D ^RAORD5 Q:RAHS=0!(RAX["^")
65 . S GMTSTYP=+$P($G(^RAMIS(71,+RA751(2),0)),"^",13)
66 . Q:GMTSTYP'>0!($D(^TMP($J,"RAHS",GMTSTYP,RADFN)))
67 . I $E(IOST)="C" D CRCHK^RAORD6 Q:RAX["^"
68 . K DIROUT W:$Y>0 @IOF D ENX^GMTSDVR(RADFN,GMTSTYP)
69 . S RAPGE=0,^TMP($J,"RAHS",GMTSTYP,RADFN)=""
70 . S:$D(DIROUT) RAX="^"
71 . Q
72 Q
73HS ; print Health Summary for each patient?
74 W ! K DIR,DIRUT,DIROUT,DTOUT,DUOUT
75 S DIR(0)="Y",DIR("A")="Print HEALTH SUMMARY for each patient"
76 D ^DIR K DIR
77 Q:$D(DIRUT)
78 S RAHS=+Y
79 Q
Note: See TracBrowser for help on using the repository browser.