- PSBRPC1 ;BIRMINGHAM/VN - BCMA RPC BROKER CALLS ;29-May-2012 14:22;PLS
- ;;3.0;BAR CODE MED ADMIN;**42,1015**;23-May-2012 13:30;Build 62
- ;
- ; Reference/IA
- ; ^%ZIS/812
- ; ^XUSEC/10076
- ; File 200/10060
- ;
- ; Modified - IHS/MSC/PLS - 09/19/2007 - Line DEVICE+17 - Added OTH as a valid device type
- DEVICE(RESULTS,FROM,DIR) ;
- ;
- ; RPC: PSB DEVICE
- ;
- ; Return a subset of entries from the Device file
- ;
- ; .LST(n)=IEN;Name^DisplayName^Location^RMar^PLen
- ; FROM=text to $O from, DIR=$O direction
- K RESULTS
- N I,IEN,SHOW,X S I=0,CNT=20
- I FROM["<" S FROM=$RE($P($RE(FROM),"< ",2))
- F Q:I'<CNT S FROM=$O(^%ZIS(1,"B",FROM),DIR) Q:FROM="" D
- . S IEN=0 F S IEN=$O(^%ZIS(1,"B",FROM,IEN)) Q:'IEN D
- .. N X0,X1,X90,X91,X95,XTYPE,XSTYPE,XTIME,%A,%X,POP
- .. Q:'$D(^%ZIS(1,IEN,0))
- .. 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"))
- .. I $E($G(^%ZIS(2,+XSTYPE,0)))'="P" Q ;Printers only
- .. S X=$P(XTYPE,"^") ;Device Types
- .. I $G(DUZ("AG"))="V",X'="TRM",X'="HG",X'="HFS",X'="CHAN" Q
- .. ;I $G(DUZ("AG"))="I",X'="OTH" Q ;IHS/MSC/PLS - 05/23/2012 - corrected the device check statement
- .. I $G(DUZ("AG"))="I",X'="TRM",X'="HG",X'="HFS",X'="CHAN",X'="OTH" Q ;Device Types
- .. S X=X0 I ($P(X,U,2)="0")!($P(X,U,12)=2) Q ;Queuing allowed
- .. S X=+X90 I X,(X'>DT) Q ;Out of Service
- .. 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
- .. S POP=0
- .. 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
- .. Q:POP ;Security check
- .. S SHOW=$P(X0,U) I SHOW'=FROM S SHOW=FROM_" <"_SHOW_">"
- .. 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)
- .. S RESULTS(0)=I
- I '$D(RESULTS(0)) S RESULTS(0)=1,RESULTS(1)="-1^No printers on file"
- Q
- GPROV(RESULTS,DUMMY) ;
- K ^TMP("PSB",$J)
- S RESULTS=$NAME(^TMP("PSB",$J)),PSBCNT=1,^TMP("PSB",$J,0)=0
- D NOW^%DTC
- S X="" F S X=$O(^XUSEC("PROVIDER",X)) Q:X="" D
- .S PSBIACT=$$GET1^DIQ(200,X_",",53.4,"I") I PSBIACT'="",+PSBIACT'<% Q ;if Inactive date and date is less than now Q
- .S PSBTERM=$$GET1^DIQ(200,X_",",9.2,"I") I PSBTERM'="",+PSBTERM'<% Q ;if termination date and date is less than now Q
- .Q:'$$GET1^DIQ(200,X_",",53.1,"I") ;is authorized to write med orders
- .Q:'$$GET1^DIQ(200,X_",",53.2) ;must have DEA#
- .S ^TMP("PSBL",$J,$$GET1^DIQ(200,X_",",.01),X)=""
- S X="^TMP(""PSBL"","_$J_")",PSBCNT=1,^TMP("PSB",$J,0)=0
- 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
- K ^TMP("PSBL",$J),PSBIACT,PSBTERM,PSBAUTH,PSBCNT,DUMMY
- PSBRPC1 ;BIRMINGHAM/VN - BCMA RPC BROKER CALLS ;29-May-2012 14:22;PLS
- +1 ;;3.0;BAR CODE MED ADMIN;**42,1015**;23-May-2012 13:30;Build 62
- +2 ;
- +3 ; Reference/IA
- +4 ; ^%ZIS/812
- +5 ; ^XUSEC/10076
- +6 ; File 200/10060
- +7 ;
- +8 ; Modified - IHS/MSC/PLS - 09/19/2007 - Line DEVICE+17 - Added OTH as a valid device type
- DEVICE(RESULTS,FROM,DIR) ;
- +1 ;
- +2 ; RPC: PSB DEVICE
- +3 ;
- +4 ; Return a subset of entries from the Device file
- +5 ;
- +6 ; .LST(n)=IEN;Name^DisplayName^Location^RMar^PLen
- +7 ; FROM=text to $O from, DIR=$O direction
- +8 KILL RESULTS
- +9 NEW I,IEN,SHOW,X
- SET I=0
- SET CNT=20
- +10 IF FROM["<"
- SET FROM=$REVERSE($PIECE($REVERSE(FROM),"< ",2))
- +11 FOR
- IF I'<CNT
- QUIT
- SET FROM=$ORDER(^%ZIS(1,"B",FROM),DIR)
- IF FROM=""
- QUIT
- Begin DoDot:1
- +12 SET IEN=0
- FOR
- SET IEN=$ORDER(^%ZIS(1,"B",FROM,IEN))
- IF 'IEN
- QUIT
- Begin DoDot:2
- +13 NEW X0,X1,X90,X91,X95,XTYPE,XSTYPE,XTIME,%A,%X,POP
- +14 IF '$DATA(^%ZIS(1,IEN,0))
- QUIT
- +15 SET X0=$GET(^%ZIS(1,IEN,0))
- SET X1=$GET(^(1))
- SET X90=$GET(^(90))
- SET X91=$GET(^(91))
- SET X95=$GET(^(95))
- SET XSTYPE=$GET(^("SUBTYPE"))
- SET XTIME=$GET(^("TIME"))
- SET XTYPE=$GET(^("TYPE"))
- +16 ;Printers only
- IF $EXTRACT($GET(^%ZIS(2,+XSTYPE,0)))'="P"
- QUIT
- +17 ;Device Types
- SET X=$PIECE(XTYPE,"^")
- +18 IF $GET(DUZ("AG"))="V"
- IF X'="TRM"
- IF X'="HG"
- IF X'="HFS"
- IF X'="CHAN"
- QUIT
- +19 ;I $G(DUZ("AG"))="I",X'="OTH" Q ;IHS/MSC/PLS - 05/23/2012 - corrected the device check statement
- +20 ;Device Types
- IF $GET(DUZ("AG"))="I"
- IF X'="TRM"
- IF X'="HG"
- IF X'="HFS"
- IF X'="CHAN"
- IF X'="OTH"
- QUIT
- +21 ;Queuing allowed
- SET X=X0
- IF ($PIECE(X,U,2)="0")!($PIECE(X,U,12)=2)
- QUIT
- +22 ;Out of Service
- SET X=+X90
- IF X
- IF (X'>DT)
- QUIT
- +23 ;Prohibited Times
- IF XTIME]""
- SET %A=$PIECE(XTIME,"^")
- SET %X=$PIECE($HOROLOG,",",2)
- SET %=%X\60#60+(%X\3600*100)
- SET %X=$PIECE(%A,"-",2)
- IF %X'<%A&(%'>%X&(%'<%A))!(%X<%A&(%'<%A!(%'>%X)))
- QUIT
- +24 SET POP=0
- +25 IF X95]""
- SET %X=$GET(DUZ(0))
- IF %X'="@"
- SET POP=1
- FOR %A=1:1:$LENGTH(%X)
- IF X95[$EXTRACT(%X,%A)
- SET POP=0
- QUIT
- +26 ;Security check
- IF POP
- QUIT
- +27 SET SHOW=$PIECE(X0,U)
- IF SHOW'=FROM
- SET SHOW=FROM_" <"_SHOW_">"
- +28 SET I=I+1
- SET RESULTS(I)=IEN_";"_$PIECE(X0,U)_U_SHOW_U_$PIECE(X1,U)_U_$PIECE(X91,U)_U_$PIECE(X91,U,3)
- +29 SET RESULTS(0)=I
- End DoDot:2
- End DoDot:1
- +30 IF '$DATA(RESULTS(0))
- SET RESULTS(0)=1
- SET RESULTS(1)="-1^No printers on file"
- +31 QUIT
- GPROV(RESULTS,DUMMY) ;
- +1 KILL ^TMP("PSB",$JOB)
- +2 SET RESULTS=$NAME(^TMP("PSB",$JOB))
- SET PSBCNT=1
- SET ^TMP("PSB",$JOB,0)=0
- +3 DO NOW^%DTC
- +4 SET X=""
- FOR
- SET X=$ORDER(^XUSEC("PROVIDER",X))
- IF X=""
- QUIT
- Begin DoDot:1
- +5 ;if Inactive date and date is less than now Q
- SET PSBIACT=$$GET1^DIQ(200,X_",",53.4,"I")
- IF PSBIACT'=""
- IF +PSBIACT'<%
- QUIT
- +6 ;if termination date and date is less than now Q
- SET PSBTERM=$$GET1^DIQ(200,X_",",9.2,"I")
- IF PSBTERM'=""
- IF +PSBTERM'<%
- QUIT
- +7 ;is authorized to write med orders
- IF '$$GET1^DIQ(200,X_",",53.1,"I")
- QUIT
- +8 ;must have DEA#
- IF '$$GET1^DIQ(200,X_",",53.2)
- QUIT
- +9 SET ^TMP("PSBL",$JOB,$$GET1^DIQ(200,X_",",.01),X)=""
- End DoDot:1
- +10 SET X="^TMP(""PSBL"","_$JOB_")"
- SET PSBCNT=1
- SET ^TMP("PSB",$JOB,0)=0
- +11 FOR
- SET X=$QUERY(@X)
- IF $QSUBSCRIPT(X,1)'="PSBL"
- QUIT
- SET ^TMP("PSB",$JOB,PSBCNT)=$QSUBSCRIPT(X,3)_"^"_$QSUBSCRIPT(X,4)
- SET ^TMP("PSB",$JOB,0)=PSBCNT
- SET PSBCNT=PSBCNT+1
- +12 KILL ^TMP("PSBL",$JOB),PSBIACT,PSBTERM,PSBAUTH,PSBCNT,DUMMY
