| 1 | SPNPSR19 ;HIRMFO/JWR,WAA-HUNT: X-RAY/RADIOLOGY SEARCH ;3/1/96 14:16
|
|---|
| 2 | ;;2.0;Spinal Cord Dysfunction;;01/02/1997
|
|---|
| 3 | ;
|
|---|
| 4 | EN1(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
|
|---|
| 36 | Q Q MEETSRCH
|
|---|
| 37 | TEST ;
|
|---|
| 38 | F CY=1:1:3 I $P(SPNMRK,U,CY)=SPNXR(CNT) S MEETSRCH=1
|
|---|
| 39 | Q
|
|---|
| 40 | EN2(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
|
|---|
| 53 | DIR 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
|
|---|
| 59 | DIC1 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
|
|---|
| 63 | DIC 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)
|
|---|
