Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSBRPCMO

PSBRPCMO.m

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