source: WorldVistAEHR/trunk/r/RADIOLOGY_NUCLEAR_MEDICINE-RA/RAPSAPI.m@ 775

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

initial load of WorldVistAEHR

File size: 4.6 KB
Line 
1RAPSAPI ;HOIFO/SWM-calling Pharmacy APIs ;8/29/05 08:12
2 ;;5.0;Radiology/Nuclear Medicine;**65**;Mar 16, 1998;Build 8
3 ;
4 ;DBIA: 4533 DATA^PSS50 returns external value of field from file #50
5 ;DBIA: 4533 ZERO^PSS50 returns B crossreference of file #50
6 ;DBIA: 4551 DO^PSSDI puts header info from file #50 into local vars
7 ;DBIA: 4551 ($$FNAME^PSSDI) returns field value from file #50
8 ;DBIA: 4551 DIC^PSSDI looks up & screens records from file #50
9 ;DBIA: 2055 reference to ROOT^DILFD
10 Q
11EN1(RAX,RAN) ; call data^pss50 to get external values to some fields
12 ; input RAX is ien to file 50
13 ; input RAN is field number of file 50 to display
14 N RAY,X,SCR
15 S:RAX="" RAX=+RAX
16 K ^TMP($J,"RAPSS50")
17 D DATA^PSS50(RAX,"","","","","RAPSS50")
18 S RAY=$G(^TMP($J,"RAPSS50",RAX,RAN))
19 K ^TMP($J,"RAPSS50")
20 Q RAY
21EN2(RADIC,RAUTIL) ; adapted from EN1^RASELCT
22 ; called from selradio+11^RANMUTL1
23 ;REQUIRES:
24 ; RADIC = FILE NUMBER OR GLOBAL ROOT
25 ; RADIC(0) = DIC(0) STRING
26 ; RAUTIL = NODE TO STORE DATA UNDER IN ^TMP($J,RAUTIL,
27 ; RAVACL() = ARRAY OF VA CLASS DRUGS TO INCLUDE
28 ; RAVACL("R") = INDICATE RADIOPHARMS ONLY
29 ;OPTIONAL:
30 ; RADIC("A") = DIC("A") STRING
31 ; RADIC("S") is not accepted by DIC^PSSDI
32 ;
33 ;RETURNS:
34 ; 1) RAQUIT = $S(UP_ARROW_OUT:1 , NOTHING_SELECTED:1 , 1:0)
35 ; 2) ^TMP($J,RAUTIL,EXTERNAL_.01_FIELD_DATA,IEN) = ""
36 ;
37 S RAQUIT=0
38 I ($G(RADIC)="")!($G(RADIC(0))="")!($G(RAUTIL)="") S RAQUIT=1 G EXIT
39 N DIC,PSSDIY,X,Y
40 D K S DIC=RADIC I DIC S (RADIC,DIC)=$$ROOT^DILFD(DIC) I DIC="" S RAQUIT=1 G EXIT
41 S DIC(0)=RADIC(0),DIC(0)=$TR(DIC(0),"AL") S:DIC(0)'["Z" DIC(0)=DIC(0)_"Z" S RADIC(0)=DIC(0)
42 D DO^PSSDI(50,"RA",.RADIC)
43 I PSSDIY=-1 S RAQUIT=1 G EXIT ; -1 if file access invalid
44 S RAFNAME=$P(DO,"^"),RAFLD01=$$FNAME^PSSDI(.01,50) K DO
45 S RANUM=1 K ^TMP($J,RAUTIL) D HOME^%ZIS
461 ;
47 W !!,$S(RANUM>1:"Another one (Select/De-Select): ",1:RADIC("A"))
48 R X:DTIME S:('$T)!($E(X)="^") RAQUIT=1 G:RAQUIT EXIT G:X="" EXIT S RADSEL=$S(X?1"-"1.E:1,1:0) S:RADSEL X=$E(X,2,$L(X))
49 I $L(X),(X["*") D SOME G 1
50 ;removed checking for ALL because user answered "N" to all in selradio^ranmutl1
51 D HELP:$E(X)="?"
52 ; cannot call old SEL() to prevent reselection since can't use DIC("S")
53 ; but no problem as same drug is stored only once in ^TMP
54 ;
55 ; null 6th piece skip check drug inactive dt -- want select old drugs
56 D SETVACL^RAPSAPI2("R")
57 D DIC^PSSDI(50,"RA",.RADIC,.X,"","","",.RAVACL)
58 G:+Y'>0 1
59 ; no rafld
60 I 'RADSEL,'$D(^TMP($J,RAUTIL,$E($P(Y,U,2),1,63),+Y)) S ^(+Y)="",RANUM=RANUM+1
61 I RADSEL,$D(^TMP($J,RAUTIL,$E($P(Y,U,2),1,63),+Y)) K ^(+Y) S RANUM=RANUM-$S(RANUM>0:1,1:0)
62 G 1
63EXIT ;
64 S RAQUIT=$S(RAQUIT:1,$O(^TMP($J,RAUTIL,""))="":1,1:0) K RADIC,RAUTIL
65K K %,%X,%Y,%Z,C,D0,DA,DIC,DIK,DIR,DO,RA,RAALL,RACASE,RAD0,RADSEL,RAFLD01
66 K RAFNAME,RAFNUM,RAFSCR,RALINE,RANUM,RAVALUE,X,Y,RAVACL
67 Q
68SOME ; SG 4/12/07
69 N RA50I,RADIC0,RAENTRY,RAXN,NAME
70 I $E(X,$L(X))'="*" W " ??",$C(7) Q
71 I $L(X)=1 W " ?? Enter at least 1 character before the ""*"".",$C(7) Q
72 S RADIC0=RADIC(0),RADIC(0)="" ; no terminal output
73 S RAENTRY=$E(X,1,$L(X)-1)
74 D ZERO^PSS50(,RAENTRY,,,,"RAPSS50")
75 S RAXN=""
76 F S RAXN=$O(^TMP($J,"RAPSS50","B",RAXN)) Q:RAXN="" D
77 . S RA50I=0
78 . F S RA50I=$O(^TMP($J,"RAPSS50","B",RAXN,RA50I)) Q:RA50I'>0 D
79 . . ; screen data
80 . . D SETVACL^RAPSAPI2("R")
81 . . D DIC^PSSDI(50,"RA",.RADIC,"`"_RA50I,,,,.RAVACL)
82 . . Q:+Y'>0
83 . . S NAME=$E($P(Y,U,2),1,63)
84 . . ; add
85 . . I 'RADSEL D:'$D(^TMP($J,RAUTIL,NAME,+Y)) Q
86 . . . S ^TMP($J,RAUTIL,NAME,+Y)="",RANUM=RANUM+1
87 . . ; remove
88 . . I $D(^TMP($J,RAUTIL,NAME,+Y)) K ^(+Y) S:RANUM>0 RANUM=RANUM-1
89 S RADIC(0)=RADIC0
90 K ^TMP($J,"RAPSS50")
91 Q
92HELP ;
93 N X S RA="Select a "_RAFNAME_" "_RAFLD01_" from the displayed list." D WRAP
94 W !?5,"To deselect a ",RAFLD01," type a minus sign (-)",!?5,"in front of it, e.g., -",RAFLD01,"."
95 W !?5,"Use an asterisk (*) to do a wildcard selection, e.g.,"
96 W !?5,"enter ",RAFLD01,"* to select all entries that begin"
97 W !?5,"with the text '",RAFLD01,"'. Wildcard selection is"
98 W !?5,"case sensitive."
99 G:$O(^TMP($J,RAUTIL,""))="" HLP
100SHOW S RALINE=$Y,RA="" W !!,"You have already selected:"
101 F S RA=$O(^TMP($J,RAUTIL,RA)) Q:RA=""!RAQUIT F RAD0=0:0 S RAD0=$O(^TMP($J,RAUTIL,RA,RAD0)) Q:RAD0'>0!RAQUIT D SHO
102HLP W ! S RAQUIT=0
103 Q
104SHO W !?3,RA
105 I $Y>(IOSL+RALINE-3) D PAUSE S RALINE=$Y
106 Q
107WRAP ;
108 W ! F S Y=$L($E(RA,1,IOM-20)," ") W !?5,$P(RA," ",1,Y) S RA=$P(RA," ",Y+1,999) Q:RA=""
109 Q
110PAUSE ;
111 K DIR S DIR(0)="E" D ^DIR K DIR S RAQUIT=$S(Y:0,1:1)
112 Q
113 ; exclude SETDIC and SEL(Y) sections from routine RASELCT
114 ;
115EN5() ;display identifier from file 71.9, field 5 radiopharm
116 ; ^(0) is ^RAMIS(71.9,-,0)
117 Q $$EN1(+$P(^(0),U,5),.01)
Note: See TracBrowser for help on using the repository browser.