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