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

PSIVORC2.m

Go to the documentation of this file.
  1. PSIVORC2 ;BIR/MLM - PROCESS INCOMPLETE IV ORDER - CONT ; Feb 02, 2022
  1. ;;5.0;INPATIENT MEDICATIONS;**29,49,50,65,58,85,101,110,127,151,181,267,275,257,281,313,346,355,319,399**;16 DEC 97;Build 64
  1. ;
  1. ; Reference to ^PS(51.2 is supported by DBIA #2178
  1. ; Reference to ^PS(55 is supported by DBIA #2191
  1. ; Reference to ^PS(52.6 is supported by DBIA #1231
  1. ; Reference to ^PS(52.7 is supported by DBIA #2173
  1. ; Reference to EN1^ORCFLAG is supported by DBIA #3620.
  1. ; Reference to ^PSSLOCK is supported by DBIA #2789
  1. ; Reference to ^TMP("PSODAOC",$J is supported by# DBIA 6071
  1. ;
  1. EDCHK ;Update or create new order in 55.
  1. D CKORD D:'$G(PSJIVORF) ORPARM^PSIVOREN I 'PSJIVORF W !,"Either the Inpatient Medications or the IV Medications package is not on, please check the Order Parameters file" Q
  1. I PSIVCHG,PSJIVORF D NATURE^PSIVOREN I '$D(P("NAT")) W $C(7),"Order unchanged" Q
  1. S:PSIVCHG P("21FLG")=""
  1. I $G(PSJCOM) D IV^PSJCOMV Q
  1. Q:$$NONVF()
  1. ACTIVE ;
  1. S PSJCOM=P("PRNTON")
  1. I PSJCOM D VFYIV^PSJCOMV Q
  1. S P("RES")=$P($G(^PS(53.1,+ON,0)),U,24)
  1. I P("RES")="R" S P("NEWON")=P("OLDON") S PSJOSTOP="" D
  1. .N PSJTROPI,PSJNVO S PSJNVO=$G(P("NEWON")) I (PSJNVO["P") D FILEOPI^PSJBCMA5(DFN,PSJNVO) S PSJTROPI=$$GETOPI^PSJBCMA5(DFN,PSJNVO) Q
  1. .I ($G(P("PON"))["P"),($G(ON55)=P("PON")) S PSJNVO=P("PON") D FILEOPI^PSJBCMA5(DFN,PSJNVO) S PSJTROPI=$$GETOPI^PSJBCMA5(DFN,PSJNVO)
  1. .I $G(P("NEWON")) D FILEOPI^PSJBCMA5(DFN,P("NEWON")) S PSJTROPI=$$GETOPI^PSJBCMA5(DFN,P("NEWON"))
  1. .D RUPDATE^PSIVOREN(DFN,ON,P(2)) I $P($G(^PS(53.45,+$G(PSJSYSP),6,0)),"^",3)
  1. I P("RES")'="R" S PSJORD=ON,P(17)="A",ORSTS=6,PSJORNP=P(6) D SETNEW^PSIVORFB S P("NEWON")=ON55 D @$S(PSIVCHG:"NEWORD",1:"OLDORD")
  1. ; copy activity log from Non-Verified order to Active order during Verify
  1. I $G(PSJIOPIV) D MVOPI^PSJBCMA5($G(DFN),$G(PSJORD),$G(ON55)),MVOPIAL^PSJBCMA5($G(DFN),$G(PSJORD),$G(ON55)),CPINDLOG^PSIVINDL($G(DFN),$G(PSJORD),$G(ON55))
  1. S (ON55,ON)=P("NEWON"),OD=P(2) D EN^PSIVORE
  1. D CIMOI^PSJIMO1(DFN,ON55,"",$G(PSJORD))
  1. D VF1^PSJLIACT("F","ORDER VERIFIED BY ",1)
  1. D ENLBL^PSIVOPT(2,DUZ,DFN,3,+ON55,"N")
  1. I $G(^PS(55,DFN,"IV",+ON55,4)) D EN1^PSJHL2(DFN,"ZV",ON55)
  1. L -^PS(53.1,+$G(PSJORD)) L -^PS(55,DFN,"IV",+ON55)
  1. Q
  1. ;
  1. CKORD ;Check if new order is to be created.
  1. I $G(PSIVCOPY) S PSIVCHG=0 Q
  1. N ND,PSJCHG S PSIVCHG=0,ND(0)=$G(^PS(53.1,+ON,0)),ND("PD")=$G(^PS(53.1,+ON,.2))_U_$P(ND(0),U,3)
  1. N X S X=$P($G(^PS(53.1,+ON,8)),U,5),X=$S(P(8)["@":$P(X,"@"),1:X)
  1. S ND=$S($E(P("OT"))="I":P(8),1:X)_U_+$P(ND(0),U,3)_U_+$P(ND("PD"),U)
  1. S ND=ND_U_$S($P(ND(0),U,2)=+P("CLRK"):+$P(ND(0),U,2),1:+P(6))
  1. I ND'=($S($E(P("OT"))="I":P(8),P(8)["@":$P(P(8),"@"),1:P(8))_U_+P("MR")_U_+P("PD")_U_+P(6)) S PSIVCHG=1
  1. I 'PSIVCHG I $P($G(^PS(53.1,+ON,2)),U)'=P(9) S:($G(P("DTYP"))'=1) PSIVDSFG=1 S PSIVCHG=1
  1. N ND,TDRG,TMPDRG
  1. Q:PSIVCHG
  1. D TMPDRG1^PSJMISC(DFN,$G(ON),.TMPDRG)
  1. I $$COMPARE^PSJMISC(.DRG,.TMPDRG,$S(P("DTYP")=1:0,1:1)) S PSIVCHG=1
  1. K TMPDRG
  1. Q:PSIVCHG
  1. Q
  1. CKPC ;
  1. ;PSJ*5*181 Note - No longer use by *181
  1. ;
  1. Q:PSIVCHG I $E(P("OT"))'="I" D
  1. .;
  1. .; Check IV drugs for changes.
  1. .S DNE=0 F DRGT="AD","SOL" I $D(DRG(DRGT)) S FIL="52."_$S(DRGT="AD":6,1:7) D
  1. ..N ND,TDRG,ON1 F DRGI=0:0 S DRGI=$O(DRG(DRGT,DRGI)) Q:'DRGI!DNE S TDRG(+$P(DRG(DRGT,DRGI),U),DRGI)=DRGI,TDRG("CNT")=+$G(TDRG("CNT"))+1
  1. ..F ON1=0:0 S ON1=$O(^PS(53.1,+ON,DRGT,ON1)) Q:'+ON1!DNE S ND=$G(^PS(53.1,+ON,DRGT,ON1,0)),ND("CNT")=$G(ND("CNT"))+1 D
  1. ...S DRG=+$P(ND,U) S:'$D(TDRG(+DRG)) (DNE,PSIVCHG)=1 F DRGI=0:0 S DRGI=$O(TDRG(+DRG,DRGI)) Q:'DRGI!DNE I $P($G(DRG(DRGT,DRGI)),U)_U_$P($G(DRG(DRGT,DRGI)),U,3)'=$P(ND,U,1,2) S (DNE,PSIVCHG)=1
  1. ..S:$G(ND("CNT"))'=$G(TDRG("CNT")) (DNE,PSIVCHG)=1 K ND,TDRG
  1. Q
  1. ;
  1. OLDORD ; Update old order, update order links.
  1. Q:P("RES")="R"
  1. S P("OLDON")=$P($G(^PS(53.1,+ON,0)),U,25) I P("OLDON")'=ON55 S $P(^PS(55,DFN,"IV",+ON55,2),U,8)=P("RES"),$P(^(2),U,5)=P("OLDON") I P("OLDON") D
  1. .I P("OLDON")["V",$D(^PS(55,DFN,"IV",+P("OLDON"),0)) S $P(^(2),U,6)=ON55,$P(^(2),U,9)=P("RES")
  1. .I P("OLDON")["A",$D(^PS(55,DFN,5,+P("OLDON"),0)) S $P(^(0),U,26,27)=ON55_U_P("RES")
  1. .I $S(P("OLDON")["P":1,P("OLDON")["N":1,1:0),$D(^PS(53.1,+P("OLDON"),0)) S $P(^(0),U,26,27)=ON55_U_P("RES")
  1. D PUT531^PSIVORFA S $P(^PS(53.1,+ON,0),U,25,26)="^",ON=ON55 D UPD100^PSIVORFA
  1. Q
  1. ;
  1. NEWORD ; Create new order, update order links.
  1. Q:P("RES")="R"
  1. S $P(^PS(53.1,+ON,0),U,26,27)=P("NEWON")_U_"E",PSIVAC="CE",PSJORNAT=P("NAT") D DC^PSIVORA
  1. S P("NEWON")=$P($G(^PS(53.1,+PSJORD,0)),U,26),$P(^PS(55,DFN,"IV",+P("NEWON"),2),U,5)=PSJORD,$P(^(2),U,8)="E",ON=ON55
  1. I PSJIVORF D EN1^PSJHL2(DFN,"SN",+ON55_"V","NEW ORDER CREATED")
  1. Q
  1. ;
  1. GTIVDRG ; Try to find an IV drug from the Orderable Item.
  1. ; If there is only 1 match to OI then stuff in DRG otherwise prompt user to select which
  1. ; ad/sol matched to OI
  1. K PSIVOI N FIL,ND,SCR,PSJNOW
  1. D NOW^%DTC S PSJNOW=%
  1. S SCR("S")="S ND=$P($G(^(""I"")),U) I ND=""""!(ND>PSJNOW)"
  1. F FIL=52.6,52.7 D FIND^DIC(FIL,,"@;.01;2"_$S(FIL=52.6:";19",1:""),"QXP",+P("PD"),,"AOI",SCR("S"),,"PSIVOI") I +PSIVOI("DILIST",0)>0 D Q
  1. . S DRGT=$S(FIL=52.6:"AD",1:"SOL"),PSIVOI=DRGT
  1. . I PSIVOI="AD" D
  1. .. N XX,XXX,QC S XX=0 F S XX=$O(PSIVOI("DILIST",XX)) Q:XX="" S XXX=+PSIVOI("DILIST",XX,0) D LIST^DIC(52.61,","_XXX_",","@;.01;1;4","PQ",,,,,,,"PSIVQC") D
  1. ... I +$G(PSIVQC("DILIST",0))>0 S QC=0 F S QC=$O(PSIVQC("DILIST",QC)) Q:QC="" S PSIVOI("DILIST",XX,QC,0)=PSIVQC("DILIST",QC,0)
  1. ... K PSIVQC("DILIST",0),PSIVQC("DILIST",0,"MAP")
  1. .. D RESET
  1. . I +PSIVOI("DILIST",0)=1 D
  1. .. S DRG=+PSIVOI("DILIST",1,0)
  1. .. S DNE=1,DRG(DRGT,0)=1,ND=$G(^PS(FIL,+DRG,0)),DRG(DRGT,1)=+DRG_U_$P(ND,U)_U_$S(FIL=52.7:$P(ND,U,3),1:"")_U_U_$P(ND,U,13)_U_$P(ND,U,11)
  1. K:+PSIVOI("DILIST",0)<2 PSIVOI
  1. Q
  1. ;
  1. EDIT ; Edit incomplete order
  1. K PSIVENO
  1. S PSIVAC="CE"
  1. I $E(P("OT"))="I",'$D(DRG("AD")),('$D(DRG("SOL"))) D GTIVDRG
  1. I P(4)="" D 53^PSIVORC1 Q:P(4)="" D ^PSIVORV2
  1. D GSTRING^PSIVORE1,GTFLDS^PSIVORFE ;S (PSIVOK,EDIT)="57^58^59^3"_$S(P("DTYP")=1:"^26^39",1:"")_"^63^64^"_$S($E(P("OT"))="I":"101^109^",1:"")_"10^25"_$S(+P(6)'=+P("CLRK"):"^1",1:"") D GTFLDS^PSIVORFE
  1. Q:$G(DONE)
  1. I '$G(PSIVENO) S PSIVENO=1 D EN^VALM("PSJ LM IV AC/EDIT") S VALMBCK="Q"
  1. Q
  1. ;
  1. FINISH ; Ask only for missing data in incomplete IV order.
  1. D GTDRG^PSIVORFA ; Re-setting DRG array
  1. S P("OPI")=$$ENPC^PSJUTL("V",+PSIVUP,60,P("OPI")) I $E(P("OT"))="I",'$D(DRG("AD")),('$D(DRG("SOL"))) S DNE=0 D GTIVDRG
  1. D:P(4)="" 53^PSIVORC1 Q:P(4)="" S P("DTYP")=$S(P(4)="":0,P(4)="P"!(P(23)="P")!(P(5)):1,P(4)="H":2,1:3)
  1. I 'P(2) D ENT^PSIVCAL K %DT S X=P(2),%DT="RTX" D ^%DT S P(2)=+Y
  1. I 'P(3) D ENSTOP^PSIVCAL K %DT S X=P(3),%DT="RTX" D ^%DT S P(3)=+Y
  1. I 'P("MR") S P("MR")=$O(^PS(51.2,"B","INTRAVENOUS",0))_"^IV"
  1. ;
  1. ;Will prompt users to choose Dispense IV Additive when more than one are available for the Orderable Item
  1. ;
  1. N PSJQUIT S PSJQUIT=0 D MULTADDS^PSJLIFN I $G(PSJQUIT) S VALMBCK="R" Q
  1. ;
  1. S PSIVOK="1^3^10^25^26^39^57^58^59^63^64"
  1. D CKFLDS^PSIVORC1 D:EDIT]"" EDIT^PSIVEDT G COMPLTE^PSIVORC1
  1. Q
  1. NONVF() ; Updated 53.1 status to non-verified after finish.
  1. NEW PSGOEAV S PSGOEAV=+$P(PSJSYSP0,U,9)
  1. S ^TMP("PSODAOC",$J,"IP NEW IEN")=ON
  1. I +PSJSYSU=3,PSGOEAV Q 0
  1. I +PSJSYSU=1,PSGOEAV Q 0
  1. N INDCHNG S INDCHNG=$$DIFFIND^PSGOE42($G(DFN),PSJORD,P("IND")) ;*399-IND
  1. I PSIVCHG D NWNONVF Q 1
  1. S P(17)="N",P("REN")=0
  1. D GTPD^PSIVORE2
  1. N OLCLN,NWCLN
  1. S OLCLN=$G(^PS(53.1,+ON,"DSS"))
  1. W !,"...transcribing this non-verified order...."
  1. S $P(^PS(53.1,+ON,.2),U)=""
  1. D PUT531^PSIVORFA
  1. I +INDCHNG=1 I PSJORD["P" D NEWNVAL^PSGAL5(PSJORD,6000,"INDICATION",$P(INDCHNG,U,2)) ;*399-IND
  1. D NEWNVAL^PSGAL5(ON,$S(+PSJSYSU=1:22000,+PSJSYSU=3:22005,1:22006),"","")
  1. I ($G(PSJINFIN)=2) D NEWNVAL^PSGAL5(ON,6000,"OTHER PRINT INFO")
  1. ; PSJ*319
  1. S NWCLN=$G(^PS(53.1,+ON,"DSS"))
  1. I $P(OLCLN,"^")'="",$P(OLCLN,"^")'=$P(NWCLN,"^") D NEWNVAL^PSGAL5(+ON,6000,"CLINIC",$P($G(^SC(+$P(OLCLN,"^"),0)),"^"))
  1. I $P(OLCLN,"^",2)'="",$P(OLCLN,"^",2)'=$P(NWCLN,"^",2) D NEWNVAL^PSGAL5(+ON,6000,"APPOINTMENT DATE/TIME",$P(OLCLN,"^",2))
  1. NEW PSIVORFA S PSIVORFA=1 D:ON["V" DEL55^PSIVORE2
  1. D VF
  1. Q 1
  1. NWNONVF ;Create non-verified due to edit
  1. K DA D ENGNN^PSGOETO S P("NEWON")=DA_"P",P(17)="N",P("REN")=0
  1. I $D(^PS(53.45,PSJSYSP,6,1)) D FILEOPI^PSJBCMA5(DFN,P("NEWON"))
  1. S PSJORD=ON,$P(^PS(53.1,+ON,0),U,26,27)=P("NEWON")_U_"E",PSIVAC="CE",PSJORNAT=P("NAT") D DC^PSIVORA
  1. S P("OLDON")=ON,ON=P("NEWON")
  1. I $D(^PS(53.1,+P("OLDON"),12)) M ^PS(53.1,+P("NEWON"),12)=^PS(53.1,+P("OLDON"),12)
  1. S P("RES")="E"
  1. S P("DO")="" D GTPD^PSIVORE2 ;Get dosage order if not defined for IPM IV
  1. D PUT531^PSIVORFA
  1. I +INDCHNG=1 I PSJORD["P" D NEWNVAL^PSGAL5(ON,6000,"INDICATION",$P(INDCHNG,U,2)) ;*399-IND
  1. S $P(^PS(53.1,+ON,0),U,25,26)=P("OLDON")_U_""
  1. D NEWNVAL^PSGAL5(ON,$S(+PSJSYSU=1:22000,+PSJSYSU=3:22005,1:22006),"","")
  1. D EN1^PSJHL2(DFN,"SN",ON,"SEND ORDER NUMBER")
  1. S ^TMP("PSODAOC",$J,"IP NEW IEN")=ON
  1. S:$D(PSGP)#10 PSJNOL=$$LS^PSSLOCK(PSGP,ON)
  1. D VF
  1. Q
  1. VF ; Display Verify screen
  1. Q:ON'["P"
  1. K PSJIVBD
  1. D GT531^PSIVORFA(DFN,ON)
  1. S:$G(ON)]"" (ON55,PSJORD)=ON ;* CCR 6700
  1. S PSGACT="EL"
  1. I P(17)="N",(P("OLDON")=""),(+P("CLRK")=DUZ) S PSGACT="ELD"
  1. ;I +PSJSYSU=3!(+PSJSYSU=1) S PSGACT="DELV"
  1. I +PSJSYSU=3 S PSGACT="DELV"
  1. I +PSJSYSU=1 S PSGACT="DEL" I $$FNP^PSGOE1(+ON) S PSGACT=PSGACT_"V" ;p319
  1. I +PSJSYSU=3,$L($T(EN1^ORCFLAG)) S PSGACT=PSGACT_"G"
  1. I P("OT")="I" S PSJSTAR="(1)^(5)^(7)^(9)^(10)"
  1. I P("OT")'="I" S PSJSTAR="(1)^(2)^(3)^(5)^(7)^(9)"
  1. I '$G(PSJEDFLG) D
  1. .D EN^VALM("PSJ LM IV INPT ACTIVE")
  1. K PSJEDFLG
  1. ; Only store allergy if not verified after entering the order
  1. I ($G(ON)["P"),($S(($G(PSJOCFG)="NEW OE IV"):1,($G(PSJOCFG)="FN IV"):1,$G(PSIVENO):1,1:0)) D SETOC^PSJNEWOC(ON)
  1. Q
  1. ;
  1. RESET ;Reset PSIVOI("DILIST") for additives with quick codes
  1. N XX,XXX,CNT S CNT=0
  1. S XX=0 F S XX=$O(PSIVOI("DILIST",XX)) Q:XX="" S CNT=CNT+1,LYN(CNT)=PSIVOI("DILIST",XX,0) D
  1. . S XXX=0 F S XXX=$O(PSIVOI("DILIST",XX,XXX)) Q:XXX="" D
  1. .. S CNT=CNT+1,LYN(CNT)=$P(PSIVOI("DILIST",XX,0),"^")_"^"_$P(PSIVOI("DILIST",XX,XXX,0),"^",2)_"^"_$P(PSIVOI("DILIST",XX,XXX,0),"^")_"^"_"QC"_"^"_$P(PSIVOI("DILIST",XX,XXX,0),"^",3)_"^"_$P(PSIVOI("DILIST",XX,XXX,0),"^",4)
  1. K PSIVOI("DILIST")
  1. S PSIVOI("DILIST",0)=CNT_"^*^0^"
  1. S XX=0 F S XX=$O(LYN(XX)) Q:'XX S PSIVOI("DILIST",XX,0)=LYN(XX)
  1. K LYN
  1. Q