source: WorldVistAEHR/trunk/r/SPINAL_CORD_DYSFUNCTION-SPN/SPNPSR19.m@ 1261

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

initial load of WorldVistAEHR

File size: 2.7 KB
Line 
1SPNPSR19 ;HIRMFO/JWR,WAA-HUNT: X-RAY/RADIOLOGY SEARCH ;3/1/96 14:16
2 ;;2.0;Spinal Cord Dysfunction;;01/02/1997
3 ;
4EN1(D0,BDATE,EDATE,SPNTYPE,ACTION,SEQUENCE) ; *** Search entry point
5 ; Input:
6 ; ACTION,SEQUENCE = Search ACTION,SEQUENCE number
7 ; D0 = SCD (SPINAL CORD) REGISTRY file (#154) IEN
8 ; ^TMP($J,"SPNPRT",ACTION,SEQUENCE,"RAD",SPNTYPE) = SPNTYPE
9 ; ^TMP($J,"SPNPRT",ACTION,SEQUENCE,"RAD",SPNTYPE,IEN) = ENTRY
10 ; ^TMP($J,"SPNPRT",ACTION,SEQUENCE,"BEGINING DATE") = Date ^ Date(ext)
11 ; ^TMP($J,"SPNPRT",ACTION,SEQUENCE,"ENDING DATE") = Date ^ Date(ext)
12 ; SPNTYPE = Type of exam 1/A = AMIS 2/T = Type of IMAGE 3/P = PROCEDURE
13 ; BDATE = Beginning date
14 ; EDATE = Ending Date
15 ; Output:
16 ; $S( D0_Meets_Search_Criteria : 1 , 1 : 0 )
17 ;
18 Q
19 N AGE,DFN,I,MEETSRCH,VA,VADM,VAERR
20 S (SPNLDFN,DFN)=+$P($G(^SPNL(154,D0,0)),U)
21 S MEETSRCH=0
22 S FDATE=9999999.9999-BDATE
23 S TDATE=9999999.9999-EDATE
24 Q:'$D(^RADPT(DFN,"DT"))
25 K SPNX,SPNXR
26 G:$O(^RADPT(DFN,"DT",TDATE))'>""!($O(^(TDATE))>FDATE) Q
27 S SPNMRK="" F CN1=1:1:3 S SPNMRK=SPNMRK_$P($G(^TMP($J,"SPNPRT",ACTION,SEQUENCE,"TEST",CN)),U)_U
28 S CN=TDATE F S CN=$O(^RADPT(DFN,"DT",CN)) Q:CN>FDATE!(MEETSRCH>0)!(CN="") D
29 .I SPNTYP="T" S CNT=CN D Q
30 ..S SPNXR(CNT)=$P($G(^RADPT(DFN,"DT",CNT,0)),U,2)
31 ..D TEST Q
32 .Q:MEETSRCH>0!(SPNTYP="T")
33 .S CNT=0 F S CNT=$O(^RADPT(DFN,"DT",CN,"P",CNT)) Q:CNT'>0 S SPNX=$G(^(CNT,0)) D
34 ..I SPNTYP="P" S SPNXR(CNT)=$P(SPNX,U,2) D TEST
35 ..I SPNTYP="A" I $P(SPNX,U,2)>0 F CNN=1:1 S CNN=$O(^RAMIS(71,$P(SPNXR,U,2),2,CNN)) Q:$G(^(CNN,0))'>0!(MEETSRCH>0) S SPNXR(CNT)=$P($G(^(0)),U) D TEST
36Q Q MEETSRCH
37TEST ;
38 F CY=1:1:3 I $P(SPNMRK,U,CY)=SPNXR(CNT) S MEETSRCH=1
39 Q
40EN2(ACTION,SEQUENCE) ; *** Prompt entry point
41 ; Input:
42 ; ACTION,SEQUENCE = Search ACTION,SEQUENCE number
43 ; Output:
44 ; SPNLEXIT = $S( User_Abort/Timeout : 1 , 1 : 0 )
45 ;
46 D Q
47 . ;I $$VERSION^XPDUTL("RA")<4.5 D Q
48 . W !!," Not avaible" Q
49 . W !!," ---Radiology files required to do this search do not exist---",!!
50 . S SPNLEXIT=1
51 N SPNX,AGE,DIR,DIRUT,DTOUT,DUOUT,I
52 K ^TMP($J,"SPNPRT",ACTION,SEQUENCE),DIR
53DIR S DIR(0)="S^1:Rad/Nuc Med AMIS Codes;2:Type of Imaging;3:Rad/Nuc Med Procedure"
54 S DIR("A")="Search by which of the above"
55 K DIRUT D ^DIR
56 I $D(DIRUT) Q
57 S SPNDIR=Y_"^"_Y(0),SPNTYP=$S(Y=1:"A",Y=2:"T",Y=3:"P",1:"")
58 W !! K DIR
59DIC1 S CN=0,DIC("A")="Select "_$P(SPNDIR,U,2)_": "
60 S DIC=$S(+SPNDIR=1:71.1,+SPNDIR=2:79.2,+SPNDIR=3:71,1:"")
61 S DIC(0)="AEMNQZ"
62 Q:DIC'>0
63DIC D ^DIC Q:$D(DUOUT)!($D(DTOUT))
64 I Y'>0&(CN=0) S SPNLEXIT=1 Q
65 S CN=CN+1,DIC("A")="Another: "
66 I Y>0 D
67 . S ^TMP($J,"SPNPRT",ACTION,SEQUENCE,"FILE TO GUIDE SEARCH")=SPNDIR
68 . S ^TMP($J,"SPNPRT",ACTION,SEQUENCE,"_Title of Test #"_CN)=Y
69 G:CN<3&(Y>0) DIC
70 D EN1^SPNPSR00(ACTION,SEQUENCE)
Note: See TracBrowser for help on using the repository browser.