PSIVOREN.m

PSIVOREN ;BIR/MLM-UTILITIES FOR IV FLUIDS - OE/RR INTERFACE ; 8/10/09 7:12am

 ;;5.0; INPATIENT MEDICATIONS ;**3,18,69,110,127,133,140,134,207**;16 DEC 97;Build 31

 ;

 ; Reference to ^PS(55 is supported by DBIA 2191.

 ; Reference to ^VA(200 is supported by DBIA 10060.

 ; Reference to ^DIE is supported by DBIA 10018.

 ;

ENCPP ; Check Package Parameter

 D ORPARM I 'PSJORF W !!,"Inpatient Medications is not turned on for OE/RR.",!,"You will not be able to enter or edit IV or Unit Dose orders."

 I 'PSJIVORF W !!,"IV Medications is not turned on for OE/RR.",!,"You will not be able to enter or edit IV orders."

 I 'PSJORF!'PSJIVORF S PSJIVORF="" D DONE^PSIVORA1 Q

 S PSJORL=$G(VAIN(4)) I 'PSJORL,$G(DFN) D INP^VADPT S PSJORL=$G(VAIN(4))

 S PSJORPF=0,P("OT")="F^",PSJORNP=$S($G(PSJORNP):PSJORNP,1:+$G(DUZ))

 Q

 ;

PS ; Check if MD is authorized to write med. orders.

 S PSJORPF=0 S:PSJORNP X=$G(^VA(200,+PSJORNP,"PS")) Q:$S('PSJORNP:0,'X:0,'$P(X,U,4):1,$P(X,U,4)>DT:1,1:0)  D

 .W !?2,"(The selected PROVIDER is NOT qualified to write MEDICATION orders.  You must",!,"select a valid provider to be able to continue with Inpatient Medications.)"

 .K DIC S DIC="^VA(200,",DIC(0)="AEMQZ",DIC("A")="Select PHARMACY PROVIDER: ",DIC("S")="S PSIV=$G(^(""PS"")) I PSIV,$S($P(PSIV,""^"",4)="""":1,DT<$P(PSIV,""^"",4):1,1:0)" F  W ! D ^DIC Q:$D(DUOUT)!$D(DTOUT)!(Y>0)  W $C(7),"  (Required.)"

 .K DIC S:Y'>0 PSJORPF=11 S:Y>0 PSJORNP=+Y Q

 K DTOUT

 Q

 ;

RUPDATE(DFN,ON,NSTRT) ;

 ; Update renewal orders (called from Pharmacy options).

 N DA,DIE,DR,ND,NSTOP,OSTOP,NOO,ORETURN,PSIVACT,PSIVAL,PSIVALCK,PSJOSTRT,PSGOLDOE S DIE="^PS(55,"_DFN_","

 I ON["P" S OLDON=$P($G(^PS(53.1,+ON,0)),"^",25),NOO=$P($G(^PS(53.1,+ON,.2)),"^",3)

 I ON["V" S OLDON=ON,NOO=$P($G(^PS(55,DFN,"IV",+ON,.2)),"^",5)

 I ON["U" S OLDON=$P($G(^PS(55,DFN,5,+ON,0)),U,25)

 I OLDON["P" S OLDON=$P($G(^PS(53.1,+OLDON,0)),U,25)

 I OLDON["V" S ON55=OLDON,X=$G(^PS(55,DFN,"IV",+OLDON,2)),PSJOSTRT=$P(X,U,7),OSTOP=$S(($G(PSJOSTOP)>PSJOSTRT):PSJOSTOP,1:$P($G(^(0)),U,3)),DIE=DIE_"""IV"",",DR="100////A",PSIVACT=1

 I OLDON["U" S X=$G(^PS(55,DFN,5,+OLDON,2)),PSJOSTRT=$P(X,U,7),OSTOP=$P(X,U,4),DIE=DIE_"5,"

 S NSTOP=+$S($G(P(3)):P(3),1:0),DA=+OLDON,DA(1)=DFN I 'NSTOP W !,"CAN'T RENEW THIS ORDER!" D PAUSE^VALM1 Q

 ;

 I ON["V"!(ON["P") D EXPOE^PSGOER(DFN,ON)

 ;

 S DR=DR_";"_$S(OLDON["V":.03,OLDON["U":34,1:25)_"////"_NSTOP_";"_$S(OLDON["V":"114////@;123////@",1:"105////@;107////@") S:+$G(P(6))?1.30N DR=DR_";.06////"_+P(6) D ^DIE

 I $G(P("OPI"))'="" S ^PS(55,DFN,"IV",+OLDON,3)=P("OPI")

 I ON["P" S DIE="^PS(53.1,",DR="28////A;105////@;",DA=+ON D ^DIE D

 .I $G(OLDON)["V" S PSGOLDOE=$P($G(^PS(55,DFN,"IV",+OLDON,0)),"^",21)

 .N NOEORD,VN,VNDT S NOEORD=$P(^PS(53.1,+ON,0),U,21) S VN=$P($G(^PS(53.1,+ON,4)),"^") I VN S VNDT=$P($G(^PS(53.1,+ON,4)),"^",2)

 .I NOEORD K DA,DR,DIE S DIE="^PS(55,"_DFN_",""IV"",",DA(1)=DFN,DA=+ON55,DR="110////"_+NOEORD D

 ..S DR=DR_";16////"_$S($G(VN):VN,1:"@")_";17////"_$S($G(VNDT):VNDT,1:"@")_";" D ^DIE I NOEORD[";" S $P(^PS(53.1,+ON,0),U,21)=NOEORD

 ..I $G(VN) D EN1^PSJHL2(DFN,"ZV",ON55)

 I ON["V" S DIE="^PS(55,DFN,""IV"",",DR="100////A;114////@;16////@;17////@" S DA=+ON55 D ^DIE

 N RDT S RDT=$P($G(@("^PS(53.1,"_+ON_",14,0)")),U,3) S:RDT RDT=+(^(RDT,0)) S RDT=$S(RDT:RDT,1:$$DATE^PSJUTL2) I RDT D UPDREN^PSIVOPT2(DFN,OLDON,RDT,+P(6),+$G(OSTOP),$G(NOO))

 ;

 I ON["V" D EN1^PSJHL2(DFN,"SN",ON,"NEW ORDER CREATED")

 I OLDON["V" S (ON,ON55)=OLDON,PSIVAL="",PSIVALCK="STOP",(P("FRES"),PSIVREA)="R" D LOG^PSIVORAL D

 .I $G(ON55),$G(OSTOP),$G(DFN) D STIX(OSTOP,OLDON,DFN)

 .;Add check to If statement below. If New Stop date ='s the old Stop Don't delete AIV x-ref (NSTOP'=PSJOSTOP)

 .I $G(PSJOSTOP),$G(NSTOP) I NSTOP=$P($G(^PS(55,DFN,"IV",+ON55,0)),"^",3),$D(^PS(55,"AIV",NSTOP,DFN,+ON55)),NSTOP'=PSJOSTOP K ^PS(55,"AIV",PSJOSTOP,DFN,+ON55)

 D:'$D(PSJIVORF) ORPARM Q:'PSJIVORF

 Q

 ;

RUPTXT(DFN,OLDON) ;

 ;Update ORTX( in OE/RR

 I OLDON'["V" ;; D ENUDTX^PSJOREN(DFN,OLDON,"OR") S ORIFN=$P($G(^PS(55,DFN,"IV",+OLDON,0)),U,21)

 I OLDON["V" S P("FRES")="R" D GTPC^PSIVORFB(OLDON),SORTX^PSIVORFE S ORIFN=$P($G(^PS(55,DFN,"IV",+OLDON,0)),U,21)

 Q

 ;

ORPARM ;Check if inpatient pkges are on.

 S (PSJORF,PSJIVORF)=1

 Q

 ;

NATURE ; Ask nature of order.

 Q:$G(PSJDCTYP)=2

 I '+$G(PSJSYSU) S P("NAT")="W" Q

 K P("NAT") NEW X

 I $D(XQORNOD(0)) S X=$E($P(XQORNOD(0),U,3),1,1) S:X="" X="E"

 S:'$D(X) X="N" S:"AF"[X X="E"

 I $G(PSIVCOPY) S X="N"

 S P("NAT")=$$ENNOO^PSJUTL5(X)

 K:P("NAT")=-1 P("NAT")

 Q

CLINIC ;Ask clinic where outpt is being seen for DSS

 K P("CLIN") NEW X1,X2,X,PSJDT,DIC,Y

 S X1=DT,X2=-7 D C^%DTC S PSJDT=X

 S DIC("S")="I $P($G(^SC(Y,0)),U,3)=""C"",$S('$P($G(^(""I"")),U):1,($P($G(^(""I"")),U)>PSJDT):1,(($P($G(^(""I"")),U)<PSJDT)&($P($G(^(""I"")),U,2)]"""")&(DT>$P($G(^(""I"")),U,2))):1,1:0)"

 S DIC=44,DIC(0)="QEAZ",DIC("A")="Select CLINIC LOCATION: " D ^DIC

 I $S($D(DTOUT):1,$D(DUOUT):1,1:0) Q

 S:+Y>0 P("CLIN")=+Y,$P(^PS(55,DFN,"IV",+ON55,"DSS"),"^")=+Y

 Q

 ;

STIX(OST,OON,DFN) ; Check start index, cleanup old start

 I $G(OST),$G(OON) S OS="" F  S OS=$O(^PS(55,DFN,"IV","AIS",OS)) Q:'OS  D

 . Q:'$D(^PS(55,DFN,"IV","AIS",OS,+OON))

 . I $P($G(^PS(55,DFN,"IV",+OON,0)),"^",3)'=OS K ^PS(55,DFN,"IV","AIS",OS,+OON)

 Q

PSIVOREN  ;BIR/MLM-UTILITIES FOR IV FLUIDS - OE/RR INTERFACE ; 8/10/09 7:12am

 +1       ;;5.0; INPATIENT MEDICATIONS ;**3,18,69,110,127,133,140,134,207**;16 DEC 97;Build 31

 +2       ;

 +3       ; Reference to ^PS(55 is supported by DBIA 2191.

 +4       ; Reference to ^VA(200 is supported by DBIA 10060.

 +5       ; Reference to ^DIE is supported by DBIA 10018.

 +6       ;

ENCPP     ; Check Package Parameter

 +1        DO ORPARM

           IF 'PSJORF

               WRITE !!,"Inpatient Medications is not turned on for OE/RR.",!,"You will not be able to enter or edit IV or Unit Dose orders."

 +2        IF 'PSJIVORF

               WRITE !!,"IV Medications is not turned on for OE/RR.",!,"You will not be able to enter or edit IV orders."

 +3        IF 'PSJORF!'PSJIVORF

               SET PSJIVORF=""

               DO DONE^PSIVORA1

               QUIT 

 +4        SET PSJORL=$GET(VAIN(4))

           IF 'PSJORL

               IF $GET(DFN)

                   DO INP^VADPT

                   SET PSJORL=$GET(VAIN(4))

 +5        SET PSJORPF=0

           SET P("OT")="F^"

           SET PSJORNP=$SELECT($GET(PSJORNP):PSJORNP,1:+$GET(DUZ))

 +6        QUIT 

 +7       ;

PS        ; Check if MD is authorized to write med. orders.

 +1        SET PSJORPF=0

           IF PSJORNP

               SET X=$GET(^VA(200,+PSJORNP,"PS"))

           IF $SELECT('PSJORNP

               QUIT 

           Begin DoDot:1

 +2            WRITE !?2,"(The selected PROVIDER is NOT qualified to write MEDICATION orders.  You must",!,"select a valid provider to be able to continue with Inpatient Medications.)"

 +3            KILL DIC

               SET DIC="^VA(200,"

               SET DIC(0)="AEMQZ"

               SET DIC("A")="Select PHARMACY PROVIDER: "

               SET DIC("S")="S PSIV=$G(^(""PS"")) I PSIV,$S($P(PSIV,""^"",4)="""":1,DT<$P(PSIV,""^"",4):1,1:0)"

               FOR 

                   WRITE !

                   DO ^DIC

                   IF $DATA(DUOUT)!$DATA(DTOUT)!(Y>0)

                       QUIT 

                   WRITE $CHAR(7),"  (Required.)"

 +4            KILL DIC

               IF Y'>0

                   SET PSJORPF=11

               IF Y>0

                   SET PSJORNP=+Y

               QUIT 

           End DoDot:1

 +5        KILL DTOUT

 +6        QUIT 

 +7       ;

RUPDATE(DFN,ON,NSTRT) ;

 +1       ; Update renewal orders (called from Pharmacy options).

 +2        NEW DA,DIE,DR,ND,NSTOP,OSTOP,NOO,ORETURN,PSIVACT,PSIVAL,PSIVALCK,PSJOSTRT,PSGOLDOE

           SET DIE="^PS(55,"_DFN_","

 +3        IF ON["P"

               SET OLDON=$PIECE($GET(^PS(53.1,+ON,0)),"^",25)

               SET NOO=$PIECE($GET(^PS(53.1,+ON,.2)),"^",3)

 +4        IF ON["V"

               SET OLDON=ON

               SET NOO=$PIECE($GET(^PS(55,DFN,"IV",+ON,.2)),"^",5)

 +5        IF ON["U"

               SET OLDON=$PIECE($GET(^PS(55,DFN,5,+ON,0)),U,25)

 +6        IF OLDON["P"

               SET OLDON=$PIECE($GET(^PS(53.1,+OLDON,0)),U,25)

 +7        IF OLDON["V"

               SET ON55=OLDON

               SET X=$GET(^PS(55,DFN,"IV",+OLDON,2))

               SET PSJOSTRT=$PIECE(X,U,7)

               SET OSTOP=$SELECT(($GET(PSJOSTOP)>PSJOSTRT):PSJOSTOP,1:$PIECE($GET(^(0)),U,3))

               SET DIE=DIE_"""IV"","

               SET DR="100////A"

               SET PSIVACT=1

 +8        IF OLDON["U"

               SET X=$GET(^PS(55,DFN,5,+OLDON,2))

               SET PSJOSTRT=$PIECE(X,U,7)

               SET OSTOP=$PIECE(X,U,4)

               SET DIE=DIE_"5,"

 +9        SET NSTOP=+$SELECT($GET(P(3)):P(3),1:0)

           SET DA=+OLDON

           SET DA(1)=DFN

           IF 'NSTOP

               WRITE !,"CAN'T RENEW THIS ORDER!"

               DO PAUSE^VALM1

               QUIT 

 +10      ;

 +11       IF ON["V"!(ON["P")

               DO EXPOE^PSGOER(DFN,ON)

 +12      ;

 +13       SET DR=DR_";"_$SELECT(OLDON["V":.03,OLDON["U":34,1:25)_"////"_NSTOP_";"_$SELECT(OLDON["V":"114////@;123////@",1:"105////@;107////@")

           IF +$GET(P(6))?1.30N

               SET DR=DR_";.06////"_+P(6)

           DO ^DIE

 +14       IF $GET(P("OPI"))'=""

               SET ^PS(55,DFN,"IV",+OLDON,3)=P("OPI")

 +15       IF ON["P"

               SET DIE="^PS(53.1,"

               SET DR="28////A;105////@;"

               SET DA=+ON

               DO ^DIE

               Begin DoDot:1

 +16               IF $GET(OLDON)["V"

                       SET PSGOLDOE=$PIECE($GET(^PS(55,DFN,"IV",+OLDON,0)),"^",21)

 +17               NEW NOEORD,VN,VNDT

                   SET NOEORD=$PIECE(^PS(53.1,+ON,0),U,21)

                   SET VN=$PIECE($GET(^PS(53.1,+ON,4)),"^")

                   IF VN

                       SET VNDT=$PIECE($GET(^PS(53.1,+ON,4)),"^",2)

 +18               IF NOEORD

                       KILL DA,DR,DIE

                       SET DIE="^PS(55,"_DFN_",""IV"","

                       SET DA(1)=DFN

                       SET DA=+ON55

                       SET DR="110////"_+NOEORD

                       Begin DoDot:2

 +19                       SET DR=DR_";16////"_$SELECT($GET(VN):VN,1:"@")_";17////"_$SELECT($GET(VNDT):VNDT,1:"@")_";"

                           DO ^DIE

                           IF NOEORD[";"

                               SET $PIECE(^PS(53.1,+ON,0),U,21)=NOEORD

 +20                       IF $GET(VN)

                               DO EN1^PSJHL2(DFN,"ZV",ON55)

                       End DoDot:2

               End DoDot:1

 +21       IF ON["V"

               SET DIE="^PS(55,DFN,""IV"","

               SET DR="100////A;114////@;16////@;17////@"

               SET DA=+ON55

               DO ^DIE

 +22       NEW RDT

           SET RDT=$PIECE($GET(@("^PS(53.1,"_+ON_",14,0)")),U,3)

           IF RDT

               SET RDT=+(^(RDT,0))

           SET RDT=$SELECT(RDT:RDT,1:$$DATE^PSJUTL2)

           IF RDT

               DO UPDREN^PSIVOPT2(DFN,OLDON,RDT,+P(6),+$GET(OSTOP),$GET(NOO))

 +23      ;

 +24       IF ON["V"

               DO EN1^PSJHL2(DFN,"SN",ON,"NEW ORDER CREATED")

 +25       IF OLDON["V"

               SET (ON,ON55)=OLDON

               SET PSIVAL=""

               SET PSIVALCK="STOP"

               SET (P("FRES"),PSIVREA)="R"

               DO LOG^PSIVORAL

               Begin DoDot:1

 +26               IF $GET(ON55)

                       IF $GET(OSTOP)

                           IF $GET(DFN)

                               DO STIX(OSTOP,OLDON,DFN)

 +27      ;Add check to If statement below. If New Stop date ='s the old Stop Don't delete AIV x-ref (NSTOP'=PSJOSTOP)

 +28               IF $GET(PSJOSTOP)

                       IF $GET(NSTOP)

                           IF NSTOP=$PIECE($GET(^PS(55,DFN,"IV",+ON55,0)),"^",3)

                               IF $DATA(^PS(55,"AIV",NSTOP,DFN,+ON55))

                                   IF NSTOP'=PSJOSTOP

                                       KILL ^PS(55,"AIV",PSJOSTOP,DFN,+ON55)

               End DoDot:1

 +29       IF '$DATA(PSJIVORF)

               DO ORPARM

           IF 'PSJIVORF

               QUIT 

 +30       QUIT 

 +31      ;

RUPTXT(DFN,OLDON) ;

 +1       ;Update ORTX( in OE/RR

 +2       ;; D ENUDTX^PSJOREN(DFN,OLDON,"OR") S ORIFN=$P($G(^PS(55,DFN,"IV",+OLDON,0)),U,21)

           IF OLDON'["V"

 +3        IF OLDON["V"

               SET P("FRES")="R"

               DO GTPC^PSIVORFB(OLDON)

               DO SORTX^PSIVORFE

               SET ORIFN=$PIECE($GET(^PS(55,DFN,"IV",+OLDON,0)),U,21)

 +4        QUIT 

 +5       ;

ORPARM    ;Check if inpatient pkges are on.

 +1        SET (PSJORF,PSJIVORF)=1

 +2        QUIT 

 +3       ;

NATURE    ; Ask nature of order.

 +1        IF $GET(PSJDCTYP)=2

               QUIT 

 +2        IF '+$GET(PSJSYSU)

               SET P("NAT")="W"

               QUIT 

 +3        KILL P("NAT")

           NEW X

 +4        IF $DATA(XQORNOD(0))

               SET X=$EXTRACT($PIECE(XQORNOD(0),U,3),1,1)

               IF X=""

                   SET X="E"

 +5        IF '$DATA(X)

               SET X="N"

           IF "AF"[X

               SET X="E"

 +6        IF $GET(PSIVCOPY)

               SET X="N"

 +7        SET P("NAT")=$$ENNOO^PSJUTL5(X)

 +8        IF P("NAT")=-1

               KILL P("NAT")

 +9        QUIT 

CLINIC    ;Ask clinic where outpt is being seen for DSS

 +1        KILL P("CLIN")

           NEW X1,X2,X,PSJDT,DIC,Y

 +2        SET X1=DT

           SET X2=-7

           DO C^%DTC

           SET PSJDT=X

 +3        SET DIC("S")="I $P($G(^SC(Y,0)),U,3)=""C"",$S('$P($G(^(""I"")),U):1,($P($G(^(""I"")),U)>PSJDT):1,(($P($G(^(""I"")),U)<PSJDT)&($P($G(^(""I"")),U,2)]"""")&(DT>$P($G(^(""I"")),U,2))):1,1:0)"

 +4        SET DIC=44

           SET DIC(0)="QEAZ"

           SET DIC("A")="Select CLINIC LOCATION: "

           DO ^DIC

 +5        IF $SELECT($DATA(DTOUT):1,$DATA(DUOUT):1,1:0)

               QUIT 

 +6        IF +Y>0

               SET P("CLIN")=+Y

               SET $PIECE(^PS(55,DFN,"IV",+ON55,"DSS"),"^")=+Y

 +7        QUIT 

 +8       ;

STIX(OST,OON,DFN) ; Check start index, cleanup old start

 +1        IF $GET(OST)

               IF $GET(OON)

                   SET OS=""

                   FOR 

                       SET OS=$ORDER(^PS(55,DFN,"IV","AIS",OS))

                       IF 'OS

                           QUIT 

                       Begin DoDot:1

 +2                        IF '$DATA(^PS(55,DFN,"IV","AIS",OS,+OON))

                               QUIT 

 +3                        IF $PIECE($GET(^PS(55,DFN,"IV",+OON,0)),"^",3)'=OS

                               KILL ^PS(55,DFN,"IV","AIS",OS,+OON)

                       End DoDot:1

 +4        QUIT