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

PSIVORE.m

Go to the documentation of this file.
  1. PSIVORE ;BIR/PR,MLM-ORDER ENTRY ;29-May-2012 14:34;PLS
  1. ;;5.0; INPATIENT MEDICATIONS ;**18,29,50,56,58,81,1011,110,127,133,157,203,213,1015**;16 DEC 97;Build 62
  1. ;
  1. ; Reference to ^PS(55 is supported by DBIA 2191
  1. ; Reference to ^ORX2 is supported by DBIA #867
  1. ; Reference to ^PSSLOCK is supported by DBIA #2789
  1. ; Reference to ^DICN is supported by DBIA 10009.
  1. ; Reference to ^DIR is supported by DBIA 10026.
  1. ; Reference to EN^VALM is supported by DBIA 10118.
  1. ; Reference to ^VADPT is supported by DBIA 10061.
  1. ;
  1. ; Modified - IHS/MSC/PLS - 03/28/2011 - Line SETN+1
  1. N PSJNEW,PSJOUT,PSGPTMP,PPAGE,FLAG S PSJNEW=1
  1. ;
  1. D SITE Q:'$G(PSIVQ) K PSIVQ S PSGOP=""
  1. ;
  1. BEG ;Get patient and make sure he is living.
  1. L +^PS(53.45,DUZ):1 E D LOCKERR^PSJOE G Q
  1. ;* F K WSCHADM S PSGPTMP=0,PPAGE=1 D ENGETP^PSIV Q:DFN<0 D ASK
  1. ;* F K WSCHADM S PSGPTMP=0,PPAGE=1 D ENGETP^PSIV Q:DFN<0 S X=DFN_";DPT(" D LK^ORX2 Q:'Y D ASK S X=DFN_";DPT(" D ULK^ORX2
  1. NEW PSJLK
  1. F K WSCHADM S PSGPTMP=0,PPAGE=1 D ENGETP^PSIV Q:DFN<0 S PSJLK='$$L^PSSLOCK(DFN,1) Q:PSJLK D ASK,UL^PSSLOCK(DFN)
  1. I PSGOP,$P(PSJSYSL,"^",2)]"" D ENQL^PSGLW
  1. G Q
  1. ;
  1. ASK ;See if patient has been admitted.
  1. I VADM(6) W !?5,"Patient has died." Q
  1. I 'VAIN(4) K DIK S DIR(0)="Y",DIR("A")="Do you wish to continue",DIR("B")="NO",DIR("??")="^S HELP=""ADMYN"" D ^PSIVHLP1" W !,"This patient has not been admitted." D ^DIR K DIR Q:'Y
  1. S:VAIN(4) WSCHADM=+VAIN(4)
  1. ;
  1. SETN ;Set up patient 0 node if needed.
  1. D SETPTCX^APSPFUNC(DFN) ;IHS/MSC/PLS - 03/28/11
  1. I '$D(^PS(55,DFN,0)) K DO,DA,DD,DIC,PSIVFN S:$D(^(5.1)) PSIVFN=^(5.1) K:$D(PSIVFN) ^(5.1) S (DINUM,X)=DFN,DIC(0)="L",DIC="^PS(55," D FILE^DICN S:$D(PSIVFN) ^PS(55,DFN,5.1)=PSIVFN D K DIC,PSIVFN,DO,DA,DD,DINUM
  1. .; Mark PSJ and PSO as converted
  1. .S $P(^PS(55,DFN,5.1),"^",11)=2
  1. S PSJNARC=1
  1. S PSGP=DFN,PSJPWD=+VAIN(4),PSIVAC="P",PSIVBR="D ^PSIVOPT" D HK,ENCHS1^PSIV Q:'$D(DFN)
  1. Q
  1. ;
  1. NEW ;Ask to enter new order.
  1. D:'$D(VADM(1)) DEM^VADPT
  1. K P,PSIVCHG,PSIVTYPE,PSJOE,DIR S DIR(0)="Y",DIR("A")="New order for "_VADM(1),DIR("B")="YES",DIR("??")="^S HELP=""NEWORD"" D ^PSIVHLP" D ^DIR K DIR Q:'Y
  1. NEW X S X=DFN_";DPT(" D LK^ORX2 Q:'Y S PSJLSORX=1
  1. INMED K ON55,PSJOUT S (P(4),P("OT"),P("FRES"))="" D NEW55^PSIVORFB I '$D(ON55) D ULK G:'$D(PSJOE)&('$D(PSJOUT)) NEW G Q
  1. S P("RES")="N",PSIVAC="PN",P("PON")=ON55,PSIVUP=+$$GTPCI^PSIVUTL D NEW^PSIVORE2 I $G(P(2))="" D DEL55^PSIVORE2 D ULK G:'$D(PSJOE) NEW Q
  1. D OK L -^PS(55,DFN,"IV",+ON55) D ULK G:'$D(PSJOE) NEW
  1. ;
  1. Q ; Kill and exit.
  1. L:'$D(PSJOE) -^PS(53.45,DUZ) S PSJNKF=1 D Q^PSIV
  1. K FIL,I1,ND,PC,PDM,PSGDT,PSGID,PSGLMT,PSGSI,PSJNARC,PSIVAC,PSIVCHG,PSIVUP,PSIVX,PSJOPC
  1. Q
  1. ;
  1. ULK ;
  1. Q:'$G(PSJLSORX) ;If NEW^PSIVORE did not lock, don't kill it here.
  1. NEW X S X=DFN_";DPT(" D ULK^ORX2 K PSJLSORX
  1. Q
  1. HK ;Queue job to print MAR labels generated for this patient.
  1. I PSGOP,PSGOP'=DFN D
  1. .N PSJACPF,PSJACNWP,PSJPWD,PSJSYSL,PSJSYSW,PSJSYSW0,DFN,VAIN,VAERR S DFN=PSGOP
  1. .D INP^VADPT S PSJPWD=+VAIN(4) I PSJPWD S PSJACPF=10 S PSJACPF=10 D WP^PSJAC D:$P(PSJSYSL,U,2)]"" ENQL^PSGLW
  1. S PSGOP=DFN
  1. Q
  1. ;
  1. SITE ;See if site parameters are ok.
  1. K PSIVQ D ^PSIVXU Q:$D(XQUIT)
  1. I '$D(PSIVSN)!('$D(PSIVSITE)) W $C(7),$C(7),!!,"You have no IV ROOM parameters ... PLEASE ... PLEASE ...",!,"Exit this package and reenter properly !!",!! Q
  1. D ORPARM^PSIVOREN S PSIVQ=1
  1. Q
  1. ;
  1. OK ;Print example label, run order through checker, ask if it is ok.
  1. S P16=0,PSIVEXAM=1,(PSIVNOL,PSIVCT)=1 D GTOT^PSIVUTL(P(4)) I $G(P("PD"))="" D GTPD^PSIVORE2
  1. D ^PSIVCHK I $D(DUOUT) S X="^" G DOA
  1. I ERR=1 S X="N" G BAD
  1. W ! D ^PSIVORLB K PSIVEXAM S Y=P(2) W !,"Start date: " X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2),?30," Stop date: " S Y=P(3) X ^DD("DD") W $P(Y,"@")," ",$P(Y,"@",2),!
  1. ;PSJ*5*157 EFD for IVs
  1. D EFDIV^PSJUTL($G(ZZND))
  1. W:$G(PSIVCHG) !,"*** This change will cause a new order to be created. ***"
  1. I '$G(PSIVCOPY) G:PSIVAC["R" OK1 S X="Is this O.K.: ^"_$S(ERR:"NO",1:"YES")_"^^NO"_$S(ERR'=1:",YES",1:"") D ENQ^PSIV
  1. S PSJIVBD=1 ;var use to indicate order enter from back door
  1. BAD ;; I X["N" D GSTRING^PSIVORE1,^PSIVORV2,GTFLDS^PSIVORFE G OK
  1. I ON55["V",($G(P(21))="") S P(17)="N"
  1. I X["N" NEW PSGEBN,PSGLI S (P("INS"),PSGEBN,PSGLI)="",(PSJORD,ON)=ON55 D EN^VALM("PSJ LM IV AC/EDIT") S VALMBCK="Q" Q
  1. I X["?" S HELP="OK" D ^PSIVHLP G OK
  1. DOA I X["^" D DEL55^PSIVORE2 Q
  1. Q:$$NONVF("SN")
  1. OK1 S PSJORL=$$ENORL^PSJUTL($G(VAIN(4))),P(17)="A",ORSTS=6,ON=ON55,PSJORNP=+P(6)
  1. D:'$D(PSJIVORF) ORPARM^PSIVOREN
  1. I PSJIVORF D NATURE^PSIVOREN I '$D(P("NAT")) D DEL55^PSIVORE2 Q
  1. D SET55^PSIVORFB
  1. I PSJIVORF,($G(P(22))=.5) D CLINIC^PSIVOREN
  1. I PSJIVORF D SET^PSIVORFE S ORNATR=P("NAT"),ON=+ON55,OD=P(2) D EN1^PSJHL2(DFN,"SN",+ON55_"V","SEND ORDER NUMBER") ;,EN1^PSJHL2(DFN,"SC",+ON55_"V","NEW ORDER CREATED")
  1. D VF1^PSJLIACT("V","ORDER ENTERED AS ACTIVE BY ",1)
  1. D ENLBL^PSIVOPT(2,DUZ,DFN,3,+ON55,"N")
  1. ;
  1. CAL ;Calculate doses.
  1. ;S OD=P(2) D EN,^PSIVORE1,^PSIVOPT
  1. S OD=P(2) D EN,^PSIVOPT
  1. Q
  1. ;
  1. EN ;Update schedule interval P(15) only on continuous orders.
  1. ;This includes Hyp/Adm/Continuous Syringes/Chemos =>P(5)=0
  1. Q:'$D(DFN)!('$D(ON55)) Q:$P(^PS(55,DFN,"IV",+ON55,0),U,4)="P"!($P(^(0),U,5))!($P(^(0),U,23)="P")
  1. D SPSOL S XXX=$P(^PS(55,DFN,"IV",+ON55,0),U,8) G:'SPSOL ENQ I XXX?1N.N.1".".N1" ml/hr"!(XXX?1"0."1N1" ml/hr") S P(15)=$S('XXX:0,1:SPSOL\XXX*60+(SPSOL#XXX/XXX*60+.5)\1),$P(^PS(55,DFN,"IV",+ON55,0),U,15)=P(15) G ENQ
  1. S P(15)=$S('$P(XXX,"@",2):0,1:1440/$P(XXX,"@",2)\1),$P(^PS(55,DFN,"IV",+ON55,0),U,15)=P(15)
  1. ENQ K SPSOL,XXX Q
  1. SPSOL S SPSOL=0 F XXX=0:0 S XXX=$O(^PS(55,DFN,"IV",+ON55,"SOL",XXX)) Q:'XXX S SPSOL=SPSOL+$P(^(XXX,0),U,2)
  1. K XXX Q
  1. ENIN ;Entry for Combined IV/UD order entry. Called by PSJOE0.
  1. D HOLDHDR^PSJOE
  1. W !
  1. N PSJOUT S (DONE,FLAG)=0,PSIVAC="PN"
  1. ENIN1 ;
  1. N DA,DIR,PSJOE,PSJPCAF,PSJSYSL,WSCHADM S:$G(VAIN(4)) WSCHADM=VAIN(4)
  1. K P,PSIVCHG,PSJCOM
  1. S PSJOE=1,DIR(0)="55.01,.04O",DIR("A")="Select IV TYPE" D ^DIR
  1. I X]"",X'="^",$P("^PROFILE",X)="" S PSJOEPF=X Q
  1. S:$D(DTOUT) X="^" I "^"[X S PSJORQF=PSJORQF+$S(X="^":2,$G(FLAG):0,1:1),X="." Q
  1. S FLAG=1,PSIVTYPE=Y,(P(5),P(23))="" I "SC"[Y D @(Y_"^PSIVORC1") S $P(PSIVTYPE,U,2)=P(23)
  1. D INMED G:'$D(PSJOUT) ENIN S:$D(PSJOUT) PSJORQF=2
  1. Q
  1. NONVF(PSJOC) ;If file at NonVF then quit with 1
  1. NEW PSGOEAV S PSGOEAV=+$P(PSJSYSP0,U,9)
  1. I +PSJSYSU=3,PSGOEAV Q 0
  1. I +PSJSYSU=1,PSGOEAV Q 0
  1. K DA D ENGNN^PSGOETO S ON=DA_"P",P(17)="N",P("REN")=0
  1. D GTPD^PSIVORE2
  1. D NATURE^PSIVOREN I '$D(P("NAT")) D:ON55["V" DEL55 Q 1
  1. D:$G(VAIN(4))="" CLINIC^PSIVOREN
  1. W !,"...transcribing this non-verified order...."
  1. D PUT531^PSIVORFA
  1. D:$G(PSJOC)]"" EN1^PSJHL2(DFN,PSJOC,ON,"SEND ORDER NUMBER")
  1. D:ON55["V" DEL55
  1. NEW PSJORD S (ON55,PSJORD)=ON
  1. D VF^PSIVORC2
  1. Q 1
  1. DEL55 ;
  1. Q:ON55["P"
  1. S X=$G(^PS(55,DFN,"IV",+ON55,0))
  1. I $P(X,U,21)]"",($G(^PS(55,DFN,"IV",+ON55,2))]"") S $P(^(2),U,6)=ON,$P(^PS(53.1,+ON,0),U,25)=ON55 Q
  1. NEW PSIVORFA S PSIVORFA=1
  1. D DEL55^PSIVORE2
  1. Q