- PSIVORA1 ;BIR/MLM-UTILITIES FOR IV FLUIDS - OE/RR INTERFACE (CONT) ;05 FEB 97 / 1:30 PM
- ;;5.0; INPATIENT MEDICATIONS ;**58,110**;16 DEC 97
- ;
- ; Reference to ^PS(51.2 is supported by DBIA 2178.
- ; Reference to ^PS(55 is supported by DBIA 2191.
- ; Reference to ^PS(52.6 is supported by DBIA 1231.
- ; Reference to ^PS(52.7 is supported by DBIA 2173.
- ; Reference to ^VA(200 is supported by DBIA 10060.
- ;
- LOCKERR ; Display msg. if lock is unsuccessful.
- W $C(7),!!,"This order is being edited by another user." S OREND=1
- Q
- ;
- EDIT ; Edit an existing order.
- I ORSTS=3 W !,$C(7),"Order must be removed from HOLD before editing." S OREND=1 Q
- I ORSTS=7 W !,$C(7),"Expired orders cannot be edited." S OREND=1 Q
- D NEWENT^PSIVORFE S ON=ORPK S:ON["V" ON55=+ON D @$S(ON["V":"GT55^PSIVORFB",1:"GT531^PSIVORFA("_DFN_","""_ON_""")") F X=2,3,9,11,"IVRM" S P(X)=""
- S P("RES")=$S(ORSTS=11:P("RES"),1:"E")
- I "EN"[P("RES") S (PSIVOK,EDIT)="57^58^59^1^66"
- E D REDIT
- N DONE S PSJORNP=+P(6) K ON55 D ENED^PSIVORV1,GTFLDS^PSIVORFE I $G(DONE) S OREND=1 Q
- I PSJORSTS=11 W !,"...updating order..." D UPD100^PSIVORFA,PUT531^PSIVORFA Q
- S P("LOG")=$$DATE^PSJUTL2(),P("CLRK")=DUZ_U_$P($G(^VA(200,DUZ,0)),U)
- W !,"...creating new order..." S P(17)="U",P("OLDON")=$S(PSJORSTS=5:+ON_"P",1:+ON_"V") D ENGNN^PSGOETO S ON=DA D SET^PSIVORFE D PUT531^PSIVORFA
- I P("OLDON")["V",$D(^PS(55,DFN,"IV",+P("OLDON"),2)) S $P(^(2),U,6)=ON_"U",$P(^(2),U,9)="E" Q
- I P("OLDON")'["V",$D(^PS(53.1,+P("OLDON"),0)) S $P(^(0),U,26,27)=ON_"U"_U_"E"
- Q
- ;
- RENEW ;Renew order through OE/RR.
- I $S(ORSTS=6:0,ORSTS=7:0,1:1) W !,$C(7),"Only ACTIVE OR EXPIRED orders may be RENEWED." S OREND=1 Q
- S ON=ORPK D GT55^PSIVORFB,REDIT
- K ON55 S P(17)="U",P("OLDON")=ON F X=2,3,"IVRM","MR" S P(X)=""
- D ENED^PSIVORV1,NEWENT^PSIVORFE,EDIT^PSIVEDT W !,"...creating new order..." D ENGNN^PSGOETO S ON=DA_"P",P("RES")="R",P("FRES")="" D SET^PSIVORFE D PUT531^PSIVORFA
- S $P(^PS(55,DFN,"IV",+P("OLDON"),2),U,6)=ON,$P(^(2),U,9)="R"
- S P("NEWON")=ON,(ON,ON55)=P("OLDON"),P("FRES")="R",P("RES")="" K ORETURN D RUPTXT^PSIVOREN(DFN,ON)
- Q
- ;
- REDIT ; Set edit string for OE/RR renew.
- S X=$G(^VA(200,+DUZ,"PS")),EDIT=$S('X:"1^",'$P(X,U,4):"",$P(X,U,4)<DT:"1^",1:"")_66,PSIVOK=EDIT S:$P(EDIT,U)'=1 P(6)=DUZ_U_$P($G(^VA(200,DUZ,0)),U)
- Q
- ;
- FLUIDQO ; Process IV Fluid quick order.
- N PSIVAC,PSIVOK,EDIT,DRG,ND,PSJQOD,P,PSJORNP,PSJORL S PSIVAC="ON",PSJORNP=$G(ORNP) D PS^PSIVOREN Q:PSJORPF
- D SETUP^PSIVORFE S P("MR")="IV"_U_$O(^PS(51.2,"C","IV",0)),DFN=+ORVP
- F DRG("SC")=3,4 S DRG("TYP")=$S(DRG("SC")=3:"AD",1:"SOL"),DRG(DRG("TYP"),0)=0 I $D(^PS(57.1,PSJQO,DRG("SC"))) F PSJQOD=0:0 S PSJQOD=$O(^PS(57.1,PSJQO,DRG("SC"),PSJQOD)) Q:'PSJQOD D
- .S ND=$G(^PS(57.1,PSJQO,DRG("SC"),PSJQOD,0)),DRG(1)=+ND,DRG(3)=$P(ND,U,2)
- .S ND=$G(^PS($S(DRG("SC")=3:52.6,1:52.7),DRG(1),0)),DRG(2)=$P(ND,U),DRG(5)=$P(ND,U,13),DRG(6)=$P(ND,U,11)
- .S DRG(DRG("TYP"),0)=DRG(DRG("TYP"),0)+1,DRG(DRG("TYP"),DRG(DRG("TYP"),0))=DRG(1)_U_DRG(2)_U_DRG(3)_U_U_$P(ND,U,13)_U_$P(ND,U,11)
- S PSIVUP=+$$GTPCI^PSIVUTL
- ;K ^PS(53.45,PSIVUP,4) I $O(^PS(57.1,PSJQO,2,0)) S %X="^PS(57.1,"_+PSJQO_",2,",%Y="^PS(53.45,"_PSIVUP_",4," D %XY^%RCR
- S X=$G(^PS(57.1,+PSJQO,1)),P(8)=$P(X,U,5),PSGPCP=$P(X,U,6),(EDIT,PSIVOK)=$S(('PSGPCP&(P(8)="")):"59^66",P(8)="":"59",'PSGPCP:"66",1:"")
- S PSJORL=ORL,ORSTS=11 I EDIT'="" D ENED^PSIVORV1,EDIT^PSIVEDT Q:DONE
- K DA,DIC,ON,P("OLDON") W !!,"...transcribing this order..." D ENGNN^PSGOETO S ON=DA D NEWENT^PSIVORFE,SET^PSIVORFE D PUT531^PSIVORFA L -^PS(53.1,+ON) W !
- Q
- ;
- DONE ; Kill variables and exit
- K AD,C,DO,DFN,DRG,I,NN,P,PSGP,PSJACNWP,PSIVAC,PSIVE,PSIVLOG,PSIVREA,PSIVUP,PSIVX,PSJIVORF,PSJORL,PSJORPF,PSJORNP,PSJORSTS,SOL,SPSOL,UL80 D ENIVKV^PSGSETU
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSIVORA1 3749 printed Feb 18, 2025@23:30:57 Page 2
- PSIVORA1 ;BIR/MLM-UTILITIES FOR IV FLUIDS - OE/RR INTERFACE (CONT) ;05 FEB 97 / 1:30 PM
- +1 ;;5.0; INPATIENT MEDICATIONS ;**58,110**;16 DEC 97
- +2 ;
- +3 ; Reference to ^PS(51.2 is supported by DBIA 2178.
- +4 ; Reference to ^PS(55 is supported by DBIA 2191.
- +5 ; Reference to ^PS(52.6 is supported by DBIA 1231.
- +6 ; Reference to ^PS(52.7 is supported by DBIA 2173.
- +7 ; Reference to ^VA(200 is supported by DBIA 10060.
- +8 ;
- LOCKERR ; Display msg. if lock is unsuccessful.
- +1 WRITE $CHAR(7),!!,"This order is being edited by another user."
- SET OREND=1
- +2 QUIT
- +3 ;
- EDIT ; Edit an existing order.
- +1 IF ORSTS=3
- WRITE !,$CHAR(7),"Order must be removed from HOLD before editing."
- SET OREND=1
- QUIT
- +2 IF ORSTS=7
- WRITE !,$CHAR(7),"Expired orders cannot be edited."
- SET OREND=1
- QUIT
- +3 DO NEWENT^PSIVORFE
- SET ON=ORPK
- if ON["V"
- SET ON55=+ON
- DO @$SELECT(ON["V":"GT55^PSIVORFB",1:"GT531^PSIVORFA("_DFN_","""_ON_""")")
- FOR X=2,3,9,11,"IVRM"
- SET P(X)=""
- +4 SET P("RES")=$SELECT(ORSTS=11:P("RES"),1:"E")
- +5 IF "EN"[P("RES")
- SET (PSIVOK,EDIT)="57^58^59^1^66"
- +6 IF '$TEST
- DO REDIT
- +7 NEW DONE
- SET PSJORNP=+P(6)
- KILL ON55
- DO ENED^PSIVORV1
- DO GTFLDS^PSIVORFE
- IF $GET(DONE)
- SET OREND=1
- QUIT
- +8 IF PSJORSTS=11
- WRITE !,"...updating order..."
- DO UPD100^PSIVORFA
- DO PUT531^PSIVORFA
- QUIT
- +9 SET P("LOG")=$$DATE^PSJUTL2()
- SET P("CLRK")=DUZ_U_$PIECE($GET(^VA(200,DUZ,0)),U)
- +10 WRITE !,"...creating new order..."
- SET P(17)="U"
- SET P("OLDON")=$SELECT(PSJORSTS=5:+ON_"P",1:+ON_"V")
- DO ENGNN^PSGOETO
- SET ON=DA
- DO SET^PSIVORFE
- DO PUT531^PSIVORFA
- +11 IF P("OLDON")["V"
- IF $DATA(^PS(55,DFN,"IV",+P("OLDON"),2))
- SET $PIECE(^(2),U,6)=ON_"U"
- SET $PIECE(^(2),U,9)="E"
- QUIT
- +12 IF P("OLDON")'["V"
- IF $DATA(^PS(53.1,+P("OLDON"),0))
- SET $PIECE(^(0),U,26,27)=ON_"U"_U_"E"
- +13 QUIT
- +14 ;
- RENEW ;Renew order through OE/RR.
- +1 IF $SELECT(ORSTS=6:0,ORSTS=7:0,1:1)
- WRITE !,$CHAR(7),"Only ACTIVE OR EXPIRED orders may be RENEWED."
- SET OREND=1
- QUIT
- +2 SET ON=ORPK
- DO GT55^PSIVORFB
- DO REDIT
- +3 KILL ON55
- SET P(17)="U"
- SET P("OLDON")=ON
- FOR X=2,3,"IVRM","MR"
- SET P(X)=""
- +4 DO ENED^PSIVORV1
- DO NEWENT^PSIVORFE
- DO EDIT^PSIVEDT
- WRITE !,"...creating new order..."
- DO ENGNN^PSGOETO
- SET ON=DA_"P"
- SET P("RES")="R"
- SET P("FRES")=""
- DO SET^PSIVORFE
- DO PUT531^PSIVORFA
- +5 SET $PIECE(^PS(55,DFN,"IV",+P("OLDON"),2),U,6)=ON
- SET $PIECE(^(2),U,9)="R"
- +6 SET P("NEWON")=ON
- SET (ON,ON55)=P("OLDON")
- SET P("FRES")="R"
- SET P("RES")=""
- KILL ORETURN
- DO RUPTXT^PSIVOREN(DFN,ON)
- +7 QUIT
- +8 ;
- REDIT ; Set edit string for OE/RR renew.
- +1 SET X=$GET(^VA(200,+DUZ,"PS"))
- SET EDIT=$SELECT('X:"1^",'$PIECE(X,U,4):"",$PIECE(X,U,4)<DT:"1^",1:"")_66
- SET PSIVOK=EDIT
- if $PIECE(EDIT,U)'=1
- SET P(6)=DUZ_U_$PIECE($GET(^VA(200,DUZ,0)),U)
- +2 QUIT
- +3 ;
- FLUIDQO ; Process IV Fluid quick order.
- +1 NEW PSIVAC,PSIVOK,EDIT,DRG,ND,PSJQOD,P,PSJORNP,PSJORL
- SET PSIVAC="ON"
- SET PSJORNP=$GET(ORNP)
- DO PS^PSIVOREN
- if PSJORPF
- QUIT
- +2 DO SETUP^PSIVORFE
- SET P("MR")="IV"_U_$ORDER(^PS(51.2,"C","IV",0))
- SET DFN=+ORVP
- +3 FOR DRG("SC")=3,4
- SET DRG("TYP")=$SELECT(DRG("SC")=3:"AD",1:"SOL")
- SET DRG(DRG("TYP"),0)=0
- IF $DATA(^PS(57.1,PSJQO,DRG("SC")))
- FOR PSJQOD=0:0
- SET PSJQOD=$ORDER(^PS(57.1,PSJQO,DRG("SC"),PSJQOD))
- if 'PSJQOD
- QUIT
- Begin DoDot:1
- +4 SET ND=$GET(^PS(57.1,PSJQO,DRG("SC"),PSJQOD,0))
- SET DRG(1)=+ND
- SET DRG(3)=$PIECE(ND,U,2)
- +5 SET ND=$GET(^PS($SELECT(DRG("SC")=3:52.6,1:52.7),DRG(1),0))
- SET DRG(2)=$PIECE(ND,U)
- SET DRG(5)=$PIECE(ND,U,13)
- SET DRG(6)=$PIECE(ND,U,11)
- +6 SET DRG(DRG("TYP"),0)=DRG(DRG("TYP"),0)+1
- SET DRG(DRG("TYP"),DRG(DRG("TYP"),0))=DRG(1)_U_DRG(2)_U_DRG(3)_U_U_$PIECE(ND,U,13)_U_$PIECE(ND,U,11)
- End DoDot:1
- +7 SET PSIVUP=+$$GTPCI^PSIVUTL
- +8 ;K ^PS(53.45,PSIVUP,4) I $O(^PS(57.1,PSJQO,2,0)) S %X="^PS(57.1,"_+PSJQO_",2,",%Y="^PS(53.45,"_PSIVUP_",4," D %XY^%RCR
- +9 SET X=$GET(^PS(57.1,+PSJQO,1))
- SET P(8)=$PIECE(X,U,5)
- SET PSGPCP=$PIECE(X,U,6)
- SET (EDIT,PSIVOK)=$SELECT(('PSGPCP&(P(8)="")):"59^66",P(8)="":"59",'PSGPCP:"66",1:"")
- +10 SET PSJORL=ORL
- SET ORSTS=11
- IF EDIT'=""
- DO ENED^PSIVORV1
- DO EDIT^PSIVEDT
- if DONE
- QUIT
- +11 KILL DA,DIC,ON,P("OLDON")
- WRITE !!,"...transcribing this order..."
- DO ENGNN^PSGOETO
- SET ON=DA
- DO NEWENT^PSIVORFE
- DO SET^PSIVORFE
- DO PUT531^PSIVORFA
- LOCK -^PS(53.1,+ON)
- WRITE !
- +12 QUIT
- +13 ;
- DONE ; Kill variables and exit
- +1 KILL AD,C,DO,DFN,DRG,I,NN,P,PSGP,PSJACNWP,PSIVAC,PSIVE,PSIVLOG,PSIVREA,PSIVUP,PSIVX,PSJIVORF,PSJORL,PSJORPF,PSJORNP,PSJORSTS,SOL,SPSOL,UL80
- DO ENIVKV^PSGSETU
- +2 QUIT