192 lines
9.5 KiB
Mathematica
192 lines
9.5 KiB
Mathematica
|
PSBRPCMO ;BIRMINGHAM/EFC-MED ORDER BUTTON FUNCTIONS ;Mar 2004
|
||
|
|
;;3.0;BAR CODE MED ADMIN;**6,32**;Mar 2004;Build 32
|
||
|
|
;Per VHA Directive 2004-038 (or future revisions regarding same), this routine should not be modified.
|
||
|
|
; Reference/IA
|
||
|
|
; ^XUSEC("PROVIDER")/10076
|
||
|
|
; ^%DTC/10000
|
||
|
|
; ^XPAR/2263
|
||
|
|
; File 50/221
|
||
|
|
; File 50.7/2880
|
||
|
|
; File 200/10060
|
||
|
|
; File 52.6/436
|
||
|
|
; File 52.7/437
|
||
|
|
; $$EN^ORBCMA2/3616
|
||
|
|
; C^PSN50P65/4543
|
||
|
|
OILST(RESULTS,PSBSCAN,PSBOTYP) ;
|
||
|
|
I PSBOTYP="VAC" D VACLKU Q
|
||
|
|
I $L(PSBSCAN?.N)>31 S PSBSCAN=$E(PSBSCAN,1,31)
|
||
|
|
S PSBSCAN=$TR(PSBSCAN,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
||
|
|
D NOW^%DTC S PSBDT=%
|
||
|
|
I $$GET^XPAR("DIV","PSB ROBOT RX"),PSBSCAN?1"3"15N!(PSBSCAN?1"3"17N),123[$E(PSBSCAN,12) S PSBSCAN=$E(PSBSCAN,2,11)
|
||
|
|
S PSBCNT=0
|
||
|
|
I PSBSCAN?.N I PSBOTYP'="OIT" D ;is a scanned bar code
|
||
|
|
.I '$D(^PSDRUG(PSBSCAN)) S PSBSCAN=$$FIND1^DIC(50,"","AX",PSBSCAN,"B^C") I PSBSCAN<1 Q ; not in the drug file
|
||
|
|
.Q:PSBOTYP="UD"&($P($G(^PSDRUG(PSBSCAN,2)),U,3)'["U")
|
||
|
|
.Q:PSBOTYP="UD"&($G(^PSDRUG(PSBSCAN,"I"))&(+$G(^("I"))'>PSBDT))
|
||
|
|
.S PSBOIEN=$$GET1^DIQ(50,PSBSCAN,"PHARMACY ORDERABLE ITEM","I") Q:PSBOIEN="" ;orderable item ien
|
||
|
|
.D CPRS
|
||
|
|
.Q:PSBCPRS]""&(PSBCPRS'>PSBDT)
|
||
|
|
.;cprs orderable inact dt?
|
||
|
|
.I $P(A,U,4)="" Q
|
||
|
|
.I +$P(A,U,4)=0 Q ;not inpat pharm item
|
||
|
|
.S PSBPOI=$$GET1^DIQ(50.7,PSBOIEN,.01)
|
||
|
|
.S PSBDD=$$GET1^DIQ(50,PSBSCAN,.01)
|
||
|
|
.I PSBOTYP="UD" D Q
|
||
|
|
..S PSBDRUG="DD"_U_PSBSCAN_U_PSBDD_U_PSBOIEN_U_PSBPOI_U_PSBORIEN_U_PSBORNM
|
||
|
|
..S PSBCNT=PSBCNT+1,RESULTS(PSBCNT)=PSBDRUG,RESULTS(0)=PSBCNT
|
||
|
|
.I PSBOTYP="IV" D Q
|
||
|
|
..S PSBCNT=0
|
||
|
|
..I $P(A,U,4)=2 D
|
||
|
|
...I $D(^PSDRUG("A527",PSBSCAN)) D SOLN
|
||
|
|
...I $D(^PSDRUG("A526",PSBSCAN)) D ADD
|
||
|
|
.S PSBCNT=PSBCNT+1,RESULTS(PSBCNT)="-1^Medication does not match ordertype",RESULTS(0)=PSBCNT Q
|
||
|
|
I PSBSCAN?.N I PSBOTYP="OIT" D ;scanned?
|
||
|
|
.I '$D(^PS(50.7,PSBSCAN)) S PSBSCAN=$$FIND1^DIC(50.7,"","AX",PSBSCAN,"B^C") I PSBSCAN<1 Q ; not in the OItem file
|
||
|
|
.S PSBOIEN=PSBSCAN Q:PSBOIEN="" ;ord item ien
|
||
|
|
.D CPRS
|
||
|
|
.Q:PSBCPRS]""&(PSBCPRS'>PSBDT)
|
||
|
|
.;cprs orderable inact dt?
|
||
|
|
.I $P(A,U,4)="" Q
|
||
|
|
.I +$P(A,U,4)=0 Q ;not inpat pharm item
|
||
|
|
.S PSBPOI=$$GET1^DIQ(50.7,PSBOIEN,.01)
|
||
|
|
.S PSBDIEN=$$GETDRN^PSBOMT(PSBPOI)
|
||
|
|
.S PSBDD=$$GET1^DIQ(50,PSBDIEN,.01)
|
||
|
|
.S PSBDRUG="OIT"_U_PSBSCAN_U_PSBPOI_U_PSBDIEN_U_PSBDD_U_PSBORIEN_U_PSBORNM
|
||
|
|
.S PSBCNT=PSBCNT+1,RESULTS(PSBCNT)=PSBDRUG,RESULTS(0)=PSBCNT
|
||
|
|
.;
|
||
|
|
I PSBSCAN'?.N D
|
||
|
|
.I PSBOTYP="OIT" D OITMB
|
||
|
|
.I PSBOTYP'="OIT" K PSBMSG D LIST^DIC(50,"","2.1I;2.1","P","","",PSBSCAN,"B","","","^TMP(""PSBLST"",$J)","PSBMSG")
|
||
|
|
.;alpha-numerc look up "B" index drug file
|
||
|
|
.S X=0 F S X=$O(^TMP("PSBLST",$J,"DILIST",X)) Q:X="" D
|
||
|
|
..Q:$P(^TMP("PSBLST",$J,"DILIST",X,0),U,3)=""
|
||
|
|
..Q:$P(^TMP("PSBLST",$J,"DILIST",X,0),U,4)=""
|
||
|
|
..I PSBOTYP'="OIT" D
|
||
|
|
...I $P(^TMP("PSBLST",$J,"DILIST",X,0),U,3)'?.N S $P(^TMP("PSBLST",$J,"DILIST",X,0),U,3,99)=$P(^TMP("PSBLST",$J,"DILIST",X,0),U,4,99) Q
|
||
|
|
...S ^TMP("PSB",$J,$P(^TMP("PSBLST",$J,"DILIST",X,0),U))=^TMP("PSBLST",$J,"DILIST",X,0)
|
||
|
|
..I PSBOTYP="OIT" S ^TMP("PSB",$J,$P(^TMP("PSBLST",$J,"DILIST",X,0),U))=^TMP("PSBLST",$J,"DILIST",X,0)
|
||
|
|
.I PSBOTYP="OIT" D OITMC
|
||
|
|
.I PSBOTYP'="OIT" K ^TMP("PSBLST",$J,"DILIST"),PSBMSG D LIST^DIC(50,"","2.1I;2.1","P","","",PSBSCAN,"C","","","^TMP(""PSBLST"",$J)","PSBMSG")
|
||
|
|
.;alpha-numerc look up "C" index drug file
|
||
|
|
.S X=0 F S X=$O(^TMP("PSBLST",$J,"DILIST",X)) Q:X="" D
|
||
|
|
..Q:$P(^TMP("PSBLST",$J,"DILIST",X,0),U,3)=""
|
||
|
|
..Q:$P(^TMP("PSBLST",$J,"DILIST",X,0),U,4)=""
|
||
|
|
..I PSBOTYP'="OIT" D
|
||
|
|
...I $P(^TMP("PSBLST",$J,"DILIST",X,0),U,3)'?.N S $P(^TMP("PSBLST",$J,"DILIST",X,0),U,3,99)=$P(^TMP("PSBLST",$J,"DILIST",X,0),U,4,99) Q
|
||
|
|
...S ^TMP("PSB",$J,$P(^TMP("PSBLST",$J,"DILIST",X,0),U))=$P(^TMP("PSBLST",$J,"DILIST",X,0),U)_U_$P($G(^PSDRUG($P(^TMP("PSBLST",$J,"DILIST",X,0),U),0)),U)_U_$P(^TMP("PSBLST",$J,"DILIST",X,0),U,3,99)
|
||
|
|
..I PSBOTYP="OIT" S ^TMP("PSB",$J,$P(^TMP("PSBLST",$J,"DILIST",X,0),U))=$P(^TMP("PSBLST",$J,"DILIST",X,0),U)_U_$P($G(^PSDRUG($P(^TMP("PSBLST",$J,"DILIST",X,0),U),0)),U)_U_$P(^TMP("PSBLST",$J,"DILIST",X,0),U,3,99)
|
||
|
|
.S PSBCNT=0,RESULTS(0)=0,PSBTLNG=0
|
||
|
|
.S X="" K PSBGOT F S X=$O(^TMP("PSB",$J,X)) Q:((+X=0)!(PSBTLNG=1)) D
|
||
|
|
..I PSBOTYP'="OIT" D
|
||
|
|
...I $P(^TMP("PSB",$J,X),U,3)'?.N S $P(^TMP("PSB",$J,X),U,3,99)=$P(^TMP("PSB",$J,X),U,4,99)
|
||
|
|
...S PSBOIEN=$P(^TMP("PSB",$J,X),U,3)
|
||
|
|
...S PSBSCIEN=$P(^TMP("PSB",$J,X),U,1)
|
||
|
|
..I PSBOTYP'="OIT" Q:PSBOTYP="UD"&($P($G(^PSDRUG(PSBSCIEN,2)),U,3)'["U")
|
||
|
|
..I PSBOTYP'="OIT" Q:PSBOTYP="UD"&($G(^PSDRUG(PSBSCIEN,"I"))&(+$G(^("I"))'>PSBDT))
|
||
|
|
..I PSBOTYP="OIT" D
|
||
|
|
...S PSBOIEN=$P(^TMP("PSB",$J,X),U)
|
||
|
|
..D CPRS
|
||
|
|
..Q:PSBCPRS]""&(PSBCPRS'>PSBDT)
|
||
|
|
..;cprs orderable inact dt?
|
||
|
|
..I $P(A,U,4)="" Q
|
||
|
|
..I +$P(A,U,4)=0 Q ;not inpat pharm item
|
||
|
|
..I PSBOTYP="OIT" D Q
|
||
|
|
...I $D(PSBGOT($P(^TMP("PSB",$J,X),U,4))) S $P(RESULTS(PSBCNT),U,2)=$P(RESULTS(PSBCNT),U,2)_","_$P(^TMP("PSB",$J,X),U) Q
|
||
|
|
...S PSBDRUG="OIT"_U_$P(^TMP("PSB",$J,X),U)_U_$P(^TMP("PSB",$J,X),U,3,4)_U_PSBORIEN_U_PSBORNM,PSBGOT($P(^TMP("PSB",$J,X),U,4))=""
|
||
|
|
...S PSBCNT=PSBCNT+1,RESULTS(PSBCNT)=PSBDRUG,RESULTS(0)=PSBCNT
|
||
|
|
..I PSBOTYP="UD" D Q
|
||
|
|
...S PSBDRUG="DD"_U_$P(^TMP("PSB",$J,X),U,1,2)_U_$P(^TMP("PSB",$J,X),U,3,4)_U_PSBORIEN_U_PSBORNM
|
||
|
|
...S PSBCNT=PSBCNT+1,RESULTS(PSBCNT)=PSBDRUG,RESULTS(0)=PSBCNT
|
||
|
|
..I PSBOTYP="IV" D Q
|
||
|
|
...I $P(A,U,4)=2 D
|
||
|
|
....I $D(^PSDRUG("A527",PSBSCIEN)) D SOLNAL
|
||
|
|
....I $D(^PSDRUG("A526",PSBSCIEN)) D ADDAL
|
||
|
|
..I RESULTS(0)>100 K RESULTS S RESULTS(0)=1,RESULTS(1)=-2,PSBTLNG=1 Q
|
||
|
|
I $G(RESULTS(1))="" S RESULTS(0)=1,RESULTS(1)="-1^Invalid Medication Lookup"
|
||
|
|
K PSBDD,PSBDRUG,PSBDT,PSBDTYP,PSBSCIEN,PSBOIEN,PSBORNM,PSBORIEN,PSBPOI,PSBSCAN,PSBTLNG,PSBID,PSBCPRS,^TMP("PSB",$J),^TMP("PSBLST",$J)
|
||
|
|
Q
|
||
|
|
CPRS ;
|
||
|
|
S PSBID=PSBOIEN_";99PSP"
|
||
|
|
S A=$$EN^ORBCMA2(PSBID)
|
||
|
|
S PSBORNM=$P(A,U,2)
|
||
|
|
S PSBORIEN=$P(A,U,1)
|
||
|
|
S PSBCPRS=$P(A,U,3)
|
||
|
|
Q
|
||
|
|
SOLN ;
|
||
|
|
S X="" F S X=$O(^PSDRUG("A527",PSBSCAN,X)) Q:X="" D
|
||
|
|
.S PSBINACT=$$GET1^DIQ(52.7,X,8,"I") I PSBINACT]"",PSBINACT'>PSBDT Q
|
||
|
|
.S PSBDRUG="SOL"_U_PSBSCAN_U_PSBDD_U_PSBOIEN_U_PSBPOI_U_PSBORIEN_U_PSBORNM
|
||
|
|
.S PSBCNT=PSBCNT+1,RESULTS(PSBCNT)=PSBDRUG_U_X_U_$$GET1^DIQ(52.7,X_",",.01)_U_$$GET1^DIQ(52.7,X_",",2),RESULTS(0)=PSBCNT
|
||
|
|
Q
|
||
|
|
ADD ;
|
||
|
|
S X="" F S X=$O(^PSDRUG("A526",PSBSCAN,X)) Q:X="" D
|
||
|
|
.S PSBINACT=$$GET1^DIQ(52.6,X,12,"I") I PSBINACT]"",PSBINACT'>PSBDT Q
|
||
|
|
.S PSBDRUG="ADD"_U_PSBSCAN_U_PSBDD_U_PSBOIEN_U_PSBPOI_U_PSBORIEN_U_PSBORNM
|
||
|
|
.S PSBCNT=PSBCNT+1,RESULTS(PSBCNT)=PSBDRUG_U_X_U_$$GET1^DIQ(52.6,X_",",.01),RESULTS(0)=PSBCNT
|
||
|
|
Q
|
||
|
|
OITMB ;
|
||
|
|
K PSBMSG D LIST^DIC(50.7,"",".01I;.01","P","","",PSBSCAN,"B","","","^TMP(""PSBLST"",$J)","PSBMSG")
|
||
|
|
Q
|
||
|
|
OITMC ;
|
||
|
|
K PSBMSG D LIST^DIC(50.7,"",".01I;.01","P","","",PSBSCAN,"C","","","^TMP(""PSBLST"",$J)","PSBMSG")
|
||
|
|
Q
|
||
|
|
SOLNAL ;
|
||
|
|
S Y="" F S Y=$O(^PSDRUG("A527",PSBSCIEN,Y)) Q:Y="" D
|
||
|
|
.S PSBINACT=$$GET1^DIQ(52.7,Y,8,"I") I PSBINACT]"",PSBINACT'>PSBDT Q
|
||
|
|
.S PSBDRUG="SOL"_U_$P(^TMP("PSB",$J,X),U,1,2)_U_$P(^TMP("PSB",$J,X),U,3,4)_U_PSBORIEN_U_PSBORNM
|
||
|
|
.S PSBCNT=PSBCNT+1,RESULTS(PSBCNT)=PSBDRUG_U_Y_U_$$GET1^DIQ(52.7,Y_",",.01)_U_$$GET1^DIQ(52.7,Y_",",2),RESULTS(0)=PSBCNT
|
||
|
|
Q
|
||
|
|
ADDAL ;
|
||
|
|
S Y="" F S Y=$O(^PSDRUG("A526",PSBSCIEN,Y)) Q:Y="" D
|
||
|
|
.S PSBINACT=$$GET1^DIQ(52.6,Y,12,"I") I PSBINACT]"",PSBINACT'>PSBDT Q
|
||
|
|
.S PSBDRUG="ADD"_U_$P(^TMP("PSB",$J,X),U,1,2)_U_$P(^TMP("PSB",$J,X),U,3,4)_U_PSBORIEN_U_PSBORNM
|
||
|
|
.S PSBCNT=PSBCNT+1,RESULTS(PSBCNT)=PSBDRUG_U_Y_U_$$GET1^DIQ(52.6,Y_",",.01),RESULTS(0)=PSBCNT
|
||
|
|
Q
|
||
|
|
PROVLST(RESULTS,PSBIN) ;
|
||
|
|
K ^TMP("PSB",$J) D NOW^%DTC
|
||
|
|
S PSBIN=$TR(PSBIN,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
|
||
|
|
S RESULTS(0)=1,RESULTS(1)="-1^No provider matching input.",PSBTLNG=0
|
||
|
|
D LIST^DIC(200,"","","P","","",PSBIN,"B","","","^TMP(""PSB"",$J)","PSBMSG")
|
||
|
|
S X=0 F S X=$O(^TMP("PSB",$J,"DILIST",X)) Q:((X="")!(PSBTLNG=1)) D
|
||
|
|
.S PSBIEN=$P(^TMP("PSB",$J,"DILIST",X,0),U,1)
|
||
|
|
.I '$D(^XUSEC("PROVIDER",PSBIEN)) Q
|
||
|
|
.S PSBIACT=$$GET1^DIQ(200,PSBIEN_",",53.4,"I")
|
||
|
|
.Q:PSBIACT'=""&(+PSBIACT'>%) ;if Inactive date and date is less than now Q
|
||
|
|
.S PSBTERM=$$GET1^DIQ(200,PSBIEN_",",9.2,"I")
|
||
|
|
.Q:PSBTERM'=""&(+PSBTERM'>%) ;if termination date and date is less than now Q
|
||
|
|
.S PSBAUTH=$$GET1^DIQ(200,PSBIEN_",",53.1,"I") I PSBAUTH'=1 Q ;is AUTHORIZED TO WRITE MED ORDERS
|
||
|
|
.I RESULTS(1)["-1" S RESULTS(0)=0
|
||
|
|
.S RESULTS(0)=RESULTS(0)+1,RESULTS(RESULTS(0))=$P(^TMP("PSB",$J,"DILIST",X,0),U,1,2)
|
||
|
|
.I RESULTS(0)>100 K RESULTS S RESULTS(0)=1,RESULTS(1)=-2,PSBTLNG=1
|
||
|
|
K ^TMP("PSB",$J),PSBIN,PSBTLNG,PSBIACT,PSBIEN,PSBTERM,PSBAUTH
|
||
|
|
Q
|
||
|
|
ORDER(RESULTS,PSBHDR,PSBREC) ;
|
||
|
|
S RESULTS(0)=1,RESULTS(1)="-1^Data not filed"
|
||
|
|
S PSBDFN=$P(PSBHDR,U,1),PSBMON=$P(PSBHDR,U,2),PSBSCH=$P(PSBHDR,U,3)
|
||
|
|
S ^TMP("PSBMO",$J,PSBDFN,PSBMON,0)=PSBDFN_U_PSBMON_U_PSBREC(0)_U_PSBREC(1)_U_PSBREC(2)_U_PSBSCH
|
||
|
|
S ^TMP("PSBMO",$J,PSBDFN,PSBMON,700,0)=0,^TMP("PSBMO",$J,PSBDFN,PSBMON,800,0)=0,^TMP("PSBMO",$J,PSBDFN,PSBMON,900,0)=0
|
||
|
|
I PSBREC(3)>0 D
|
||
|
|
.S ^TMP("PSBMO",$J,PSBDFN,PSBMON,700,0)=PSBREC(3)
|
||
|
|
.F I=1:1:PSBREC(3) D
|
||
|
|
..S ^TMP("PSBMO",$J,PSBDFN,PSBMON,700,I,0)=$P(PSBREC(4),U,1)_U_$P(PSBREC(4),U,2)
|
||
|
|
..S PSBREC(4)=$P(PSBREC(4),U,3,99)
|
||
|
|
I PSBREC(5)>0 D
|
||
|
|
.S ^TMP("PSBMO",$J,PSBDFN,PSBMON,800,0)=PSBREC(5)
|
||
|
|
.F I=1:1:PSBREC(5) S ^TMP("PSBMO",$J,PSBDFN,PSBMON,800,I,0)=$P(PSBREC(6),U,I)
|
||
|
|
I PSBREC(7)>0 D
|
||
|
|
.S ^TMP("PSBMO",$J,PSBDFN,PSBMON,900,0)=PSBREC(7)
|
||
|
|
.F I=1:1:PSBREC(7) S ^TMP("PSBMO",$J,PSBDFN,PSBMON,900,I,0)=$P(PSBREC(8),U,I)
|
||
|
|
S ^TMP("PSBMO",$J,PSBDFN,PSBMON,"PSB")=DUZ_U_DUZ(2)_U_PSBREC(9)_U_$G(PSBREC(10))
|
||
|
|
S RESULTS(0)=1,RESULTS(1)="1^Data successfully filed"
|
||
|
|
Q
|
||
|
|
VACLKU ;
|
||
|
|
D C^PSN50P65(,PSBSCAN,"PSBLST")
|
||
|
|
S PSBCNT=0,RESULTS(0)=0,PSBTLNG=0
|
||
|
|
S X=0 F S X=$O(^TMP($J,"PSBLST",X)) Q:((+X=0)!(PSBTLNG=1)) D
|
||
|
|
.S PSBVAC="VAC"_U_X_U_^TMP($J,"PSBLST",X,1)_U_^TMP($J,"PSBLST",X,.01)
|
||
|
|
.S PSBCNT=PSBCNT+1,RESULTS(PSBCNT)=PSBVAC,RESULTS(0)=PSBCNT
|
||
|
|
.I RESULTS(0)>100 K RESULTS S RESULTS(0)=1,RESULTS(1)=-2,PSBTLNG=1 Q
|
||
|
|
I $G(RESULTS(1))="" S RESULTS(0)=1,RESULTS(1)="-1^Invalid Medication Lookup"
|
||
|
|
K ^TMP($J,"PSBLST"),PSBVAC
|
||
|
|
Q
|