source: FOIAVistA/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAUTL18.m

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

initial load of FOIAVistA 6/30/08 version

File size: 5.2 KB
Line 
1RAUTL18 ;HISC/DAD,GJC-PROCEDURE FILE UTILITIES ;9/11/97 14:46
2 ;;5.0;Radiology/Nuclear Medicine;;Mar 16, 1998
3EN(RAPROCD0,PROCTYPE) ;
4 ; Check/delete DESCENDENT multiple when the TYPE OF PROCEDURE changes
5 ; Input: PROCEDURE file (#71) IEN (RAPROCD0)
6 ; New TYPE OF PROCEDURE value in internal format (PROCTYPE)
7 ;
8 I PROCTYPE="P" G EN1
9 I PROCTYPE'="P" G EN2
10 ;
11EN1 ; TYPE OF PROCEDURE: Non-parent ==> Parent
12 ; Is PROCEDURE a DESCENDENT? If it is KILL X
13 ; Input: PROCEDURE file (#71) IEN (RAPROCD0)
14 N RACNT,RAEXIT,RAPARENT,RATXT,X,Y
15 S (RAPARENT,RAEXIT)=0,RACNT=101
16 F S RAPARENT=$O(^RAMIS(71,"ADESC",RAPROCD0,RAPARENT)) Q:RAPARENT'>0 D
17 . S RAPARENT(0)=$P($G(^RAMIS(71,RAPARENT,0)),U)
18 . I RAPARENT(0)]"" S RATXT(RACNT)=$J("",14)_RAPARENT(0),RACNT=RACNT+1
19 . Q
20 I $O(RATXT(0)) D S RAEXIT=1
21 . S RATXT(RACNT)=""
22 . S RATXT(1)=""
23 . S RATXT(2)="This procedure may not be changed to a parent procedure"
24 . S RATXT(3)="because it is already a descendent of the following"
25 . S RATXT(4)="procedure(s):"
26 . D EN^DDIOL(.RATXT)
27 . Q
28 Q RAEXIT
29 ;
30EN2 ; TYPE OF PROCEDURE: Parent ==> Non-parent, delete DESCENDENTS
31 ; Input: PROCEDURE file (#71) IEN (RAPROCD0)
32 N D0,D1,DA,RADESCD0,RAFDA,RATXT,RAXREF,X,Y
33 I $O(^RAMIS(71,RAPROCD0,4,0))'>0 Q 0
34 D EN^DDIOL(" Deleting descendents of this procedure."_$C(7))
35 S RADESCD0=0
36 F S RADESCD0=$O(^RAMIS(71,RAPROCD0,4,RADESCD0)) Q:RADESCD0'>0 D
37 . S RAPROC=$P($G(^RAMIS(71,RAPROCD0,4,RADESCD0,0)),U) Q:RAPROC=""
38 . S RAXREF=0
39 . F S RAXREF=$O(^DD(71.05,.01,1,RAXREF)) Q:RAXREF'>0 D
40 .. S X=RAPROC,(D0,DA(1))=RAPROCD0,(D1,DA)=RADESCD0
41 .. I $G(^DD(71.05,.01,1,RAXREF,2))]"" X ^(2)
42 .. Q
43 . K ^RAMIS(71,RAPROCD0,4,RADESCD0)
44 . Q
45 K ^RAMIS(71,RAPROCD0,4,0)
46 Q 0
47EN3(RADA) ; Displays the available sequence numbers for the current
48 ;imaging type during the Common Procedure Edit option when editing
49 ;the Sequence Number fld of file 71.3
50 Q:'$D(RACCESS)!('$D(RAMDIV))!('$D(RAMDV))!('$D(RAMLC))
51 ; proceed only if entering through Rad/Nuc Med
52 Q:'RAIMGTYI ; Quit if not present
53 N RA,RA0,RACNT,RAFLG,RAHIT,RALOWER,RAUPPER,RAIMGTYJ D HOME^%ZIS
54 S (RAFLG,RAHIT)=0,RAIMGTYJ=$P($G(^RA(79.2,+RAIMGTYI,0)),"^")
55 S RA0=$G(^RAMIS(71.3,RADA,0)),RACNT=1
56 S RALOWER=1,RAUPPER=40 ; upper and lower limits, decimals not allowed
57 W !?3,"Available Sequence Numbers for "_RAIMGTYJ_":"
58 F RA=RALOWER:1:RAUPPER D
59 . Q:$D(^RAMIS(71.3,"AA",RAIMGTYI,RA))
60 . S:RAHIT=0 RAHIT=RA
61 . I ($L($G(RA(RACNT))_RA_", ")+3)>IOM D
62 .. S RA(RACNT)=$P(RA(RACNT),", ",1,$L(RA(RACNT),", ")-1)
63 .. S RACNT=RACNT+1
64 .. Q
65 . S RA(RACNT)=$G(RA(RACNT))_RA_", "
66 . Q
67 S:RAHIT RA(RACNT)=$P(RA(RACNT),", ",1,$L(RA(RACNT),", ")-1)_"."
68 I 'RAHIT D Q
69 . I +$P(RA0,"^",4) D
70 .. W !!?5,"The only valid sequence number for an Imaging Type of"
71 .. W !?5,"'"_RAIMGTYJ_"' is: ",$P(RA0,"^",4)_".",!
72 .. Q
73 . E W !!?5,"There are no available sequence numbers.",!
74 . Q
75 S RACNT=0 F S RACNT=$O(RA(RACNT)) Q:RACNT'>0 W !,$G(RA(RACNT))
76 W ! I +$P(RA0,"^",4) D
77 . W !?5,"The current sequence number is: "_$P(RA0,"^",4)_"."
78 . Q
79 W !?5,"The"_$S(+$P(RA0,"^",4)&(+$P(RA0,"^",4)<RAHIT):" next",1:"")
80 W " lowest available sequence number is: ",RAHIT,!
81 Q
82BCDE(X) ; Output data in a barcode format. 'X' is the data to be converted.
83 ; RAIND1 & RAIND2 are newed in PRT^RAFLH. Used for indirection.
84 S RACNT=+$G(RACNT)+1
85 I X']"" S RAIND1(RACNT)=X,RAIND2="RAIND1("_RACNT_")" Q RAIND2
86 I IOBARON]"",(IOBAROFF]"") D
87 . S RAIND1(RACNT)=X,RAIND2="@IOBARON,RAIND1("_RACNT_"),@IOBAROFF"
88 . Q
89 E S RAIND1(RACNT)="",RAIND2="RAIND1("_RACNT_")"
90 Q RAIND2
91ILOC(X) ; Determines based on procedure I-Type if only one I-Loc is available
92 ; for this user.
93 ; To be called from: [RA OERR EDIT], [RA ORDER EXAM] and
94 ; [RA QUICK EXAM ORDER] input templates. (File: 75.1)
95 ; Input Variable: 'X'-> IEN of the procedure
96 ; Output Variable: 'Y'-> $S(one I-Loc of proc. I-Type: IEN of I-Loc,1:0)
97 Q:X=0 0
98 Q:'($D(^RAMIS(71,X,0))#2) 0
99 N RA791,RACNT,RAPROI,RASAV
100 S (RA791,RACNT)=0,RAPROI=+$P($G(^RAMIS(71,X,0)),"^",12) Q:'RAPROI 0
101 F S RA791=$O(^RA(79.1,"BIMG",RAPROI,RA791)) Q:RA791'>0 D Q:RACNT'<2
102 . Q:$P($G(^RA(79.1,RA791,0)),"^",19)]"" ; inactive
103 . S RACNT=RACNT+1,RASAV=RA791
104 . Q
105 W:RACNT=1 !?5,"...request submitted to: ",$P($G(^SC(+$P($G(^RA(79.1,RASAV,0)),"^"),0)),"^")
106 Q $S(RACNT=1:RASAV,1:0)
107ADDRESS(RADA,DFN) ; Pass back the address of the patient for Print Label
108 ; Fields.
109 ; Input: RADA-ien of the print label field, DFN-patient ien
110 ; Output: The street address of the patient.
111 ; It can be the street address(123 Main Street), possibly followed by
112 ; additional street address information such as 'P.O. Box' data, and
113 ; finally the city, state, and zip code.
114 Q:+DFN=0 "" Q:'$D(^RA(78.7,RADA,0))#2 ""
115 N VAERR,VAPA,X S X="" D ADD^VADPT Q:VAERR ""
116 I $D(^RA(78.7,"B","PATIENT ADDRESS LINE 1",RADA)) D
117 . S X=VAPA(1) ; 1st line of street address
118 . Q
119 I $D(^RA(78.7,"B","PATIENT ADDRESS LINE 2",RADA)) D
120 . S X=VAPA(2)_" "_VAPA(3) S:X=" " X="" ; 2nd & 3rd lines together
121 . Q
122 I $D(^RA(78.7,"B","PATIENT ADDRESS LINE 3",RADA)) D
123 . ; city, street and zip information (prefer ZIP+4, else regular ZIP)
124 . N RABBR S RABBR=$P($G(^DIC(5,+VAPA(5),0)),"^",2)
125 . S X=VAPA(4)_" "_$S(RABBR]"":RABBR,1:$P(VAPA(5),"^",2))
126 . S X=X_" "_$S($P(VAPA(11),"^",2)]"":$P(VAPA(11),"^",2),1:VAPA(6))
127 . Q
128 Q $TR(X,",."," ")
Note: See TracBrowser for help on using the repository browser.