| [613] | 1 | PSBRPC1 ;BIRMINGHAM/VN-BCMA RPC BROKER CALLS ;Mar 2004
|
|---|
| 2 | ;;3.0;BAR CODE MED ADMIN;;Mar 2004
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference/IA
|
|---|
| 5 | ; ^%ZIS/812
|
|---|
| 6 | ; ^XUSEC/10076
|
|---|
| 7 | ; File 200/10060
|
|---|
| 8 | ;
|
|---|
| 9 | DEVICE(RESULTS,FROM,DIR) ;
|
|---|
| 10 | ;
|
|---|
| 11 | ; RPC: PSB DEVICE
|
|---|
| 12 | ;
|
|---|
| 13 | ; Return a subset of entries from the Device file
|
|---|
| 14 | ;
|
|---|
| 15 | ; .LST(n)=IEN;Name^DisplayName^Location^RMar^PLen
|
|---|
| 16 | ; FROM=text to $O from, DIR=$O direction
|
|---|
| 17 | K RESULTS
|
|---|
| 18 | N I,IEN,SHOW,X S I=0,CNT=20
|
|---|
| 19 | I FROM["<" S FROM=$RE($P($RE(FROM),"< ",2))
|
|---|
| 20 | F Q:I'<CNT S FROM=$O(^%ZIS(1,"B",FROM),DIR) Q:FROM="" D
|
|---|
| 21 | . S IEN=0 F S IEN=$O(^%ZIS(1,"B",FROM,IEN)) Q:'IEN D
|
|---|
| 22 | .. N X0,X1,X90,X91,X95,XTYPE,XSTYPE,XTIME,%A,%X,POP
|
|---|
| 23 | .. Q:'$D(^%ZIS(1,IEN,0))
|
|---|
| 24 | .. S X0=$G(^%ZIS(1,IEN,0)),X1=$G(^(1)),X90=$G(^(90)),X91=$G(^(91)),X95=$G(^(95)),XSTYPE=$G(^("SUBTYPE")),XTIME=$G(^("TIME")),XTYPE=$G(^("TYPE"))
|
|---|
| 25 | .. I $E($G(^%ZIS(2,+XSTYPE,0)))'="P" Q ;Printers only
|
|---|
| 26 | .. S X=$P(XTYPE,"^") I X'="TRM",X'="HG",X'="HFS",X'="CHAN" Q ;Device Types
|
|---|
| 27 | .. S X=X0 I ($P(X,U,2)="0")!($P(X,U,12)=2) Q ;Queuing allowed
|
|---|
| 28 | .. S X=+X90 I X,(X'>DT) Q ;Out of Service
|
|---|
| 29 | .. I XTIME]"" S %A=$P(XTIME,"^"),%X=$P($H,",",2),%=%X\60#60+(%X\3600*100),%X=$P(%A,"-",2) I %X'<%A&(%'>%X&(%'<%A))!(%X<%A&(%'<%A!(%'>%X))) Q ;Prohibited Times
|
|---|
| 30 | .. S POP=0
|
|---|
| 31 | .. I X95]"" S %X=$G(DUZ(0)) I %X'="@" S POP=1 F %A=1:1:$L(%X) I X95[$E(%X,%A) S POP=0 Q
|
|---|
| 32 | .. Q:POP ;Security check
|
|---|
| 33 | .. S SHOW=$P(X0,U) I SHOW'=FROM S SHOW=FROM_" <"_SHOW_">"
|
|---|
| 34 | .. S I=I+1,RESULTS(I)=IEN_";"_$P(X0,U)_U_SHOW_U_$P(X1,U)_U_$P(X91,U)_U_$P(X91,U,3)
|
|---|
| 35 | .. S RESULTS(0)=I
|
|---|
| 36 | I '$D(RESULTS(0)) S RESULTS(0)=1,RESULTS(1)="-1^No printers on file"
|
|---|
| 37 | Q
|
|---|
| 38 | GPROV(RESULTS,DUMMY) ;
|
|---|
| 39 | K ^TMP("PSB",$J)
|
|---|
| 40 | S RESULTS=$NAME(^TMP("PSB",$J)),PSBCNT=1,^TMP("PSB",$J,0)=0
|
|---|
| 41 | D NOW^%DTC
|
|---|
| 42 | S X="" F S X=$O(^XUSEC("PROVIDER",X)) Q:X="" D
|
|---|
| 43 | .S PSBIACT=$$GET1^DIQ(200,X_",",53.4,"I") I PSBIACT'="",+PSBIACT'<% Q ;if Inactive date and date is less than now Q
|
|---|
| 44 | .S PSBTERM=$$GET1^DIQ(200,X_",",9.2,"I") I PSBTERM'="",+PSBTERM'<% Q ;if termination date and date is less than now Q
|
|---|
| 45 | .Q:'$$GET1^DIQ(200,X_",",53.1,"I") ;is authorized to write med orders
|
|---|
| 46 | .Q:'$$GET1^DIQ(200,X_",",53.2) ;must have DEA#
|
|---|
| 47 | .S ^TMP("PSBL",$J,$$GET1^DIQ(200,X_",",.01),X)=""
|
|---|
| 48 | S X="^TMP(""PSBL"","_$J_")",PSBCNT=1,^TMP("PSB",$J,0)=0
|
|---|
| 49 | F S X=$Q(@X) Q:$QS(X,1)'="PSBL" S ^TMP("PSB",$J,PSBCNT)=$QS(X,3)_"^"_$QS(X,4),^TMP("PSB",$J,0)=PSBCNT,PSBCNT=PSBCNT+1
|
|---|
| 50 | K ^TMP("PSBL",$J),PSBIACT,PSBTERM,PSBAUTH,PSBCNT,DUMMY
|
|---|
