PSJLIFNI.m

PSJLIFNI ;BIR/MV-U/D ORDER FINISHES AS IV ;13 Jan 98 / 11:32 AM

 ;;5.0; INPATIENT MEDICATIONS ;**1,29,34,37,50,94,116,110,111**;16 DEC 97

 ;

IV(PSJORD,OI) ; Prompt for missing data to be finished as IV.

 L +^PS(53.1,+PSJORD):1 I '$T W !,$C(7),$C(7),"This order is being edited by another user. Try later." D PAUSE^VALM1 Q

 D HOLDHDR^PSJOE

 ;** PSIVFN1 is use so it will dipslay the AC/Edit screen

 ;** instead of go to the "IS this O.K." prompt

 ;** PSJLIFNI is a flag to indicate U/D finishes as IV.

 K PSJIVBD

 NEW PSIVFN1,ON55,PSGORQF,PSIVACEP,DRGOC,PSJLIFNI,PSIVOI

 S PSJLIFNI=1

 S PSIVAC="CF" S (P("PON"),ON,ON55)=+PSJORD_"P",DFN=PSGP

 S PSIVUP=+$$GTPCI^PSIVUTL D GT531^PSIVORFA(DFN,ON) S P("PD")=OI_U_$$OIDF^PSJLMUT1(+OI)

 D:'$D(P("OT")) GTOT^PSIVUTL(P(4))

 S P("OPI")=$$ENPC^PSJUTL("V",+PSIVUP,60,P("OPI"))

 D 53^PSIVORC1

 I $E(P("OT"))="I" D GTDATA^PSJLIFN Q:P(4)=""

 ;I $$SCHREQ^PSJLIVFD(.P),(P(9))]"",'$$PRNOK^PSGS0(P(9)) N PSGOES,X,PSGS0XT,PSJNSS S PSJNSS=1,PSGOES=1,X=P(9),PSGS0XT=P(15) D Q2^PSGS0

 I $$SCHREQ^PSJLIVFD(.P),(P(9))]"",'$$PRNOK^PSGS0(P(9)) N PSJNSS,PSGOES,PSGS0XT,PSGS0Y,PSGAT S X=P(9),PSGS0XT=P(15),PSGAT=P(11) D

 .D EN^PSGS0 I $G(X)="" S PSGORQF=1 Q

 .I $G(PSGS0Y)>1 S P(11)=PSGS0Y

 I $E(P("OT"))="I",'$D(DRG("AD")),('$D(DRG("SOL"))) S DNE=0 D GTIVDRG^PSIVORC2 S P(3)="" D ENSTOP^PSIVCAL D ORDCHK^PSJLIFN

 I $D(PSGORQF) S VALMBCK="R",P(4)="" K DRG Q

 S ^TMP("PSJI",$J,0)=""

 S PSIVOK="1^3^10^25^26^39^57^58^59^63^64" D CKFLDS^PSIVORC1 D:EDIT]"" EDIT^PSIVEDT

 I $G(DONE) S VALMBCK="R" D EXIT Q

 D COMPLTE^PSIVORC1

 S:$D(PSIVACEP) VALMBCK="Q"

EXIT ;

 L -^PS(53.1,+PSJORD)

 Q

ORDCHK(DFN,TYPE) ;

 ;TYPE ="DD" - Duplicate drug

 ;     ="DC" - Duplicate class

 ;     -"DI" - Drug Interaction

 ;

 NEW ON,PSJL,PSIVX,PSJOC,PSJORIEN,PSJPACK,PSJLINE

 S PSJOC=0,PSJLINE=1

 F PSIVX=0:0 S PSIVX=$O(^TMP($J,TYPE,PSIVX)) Q:'PSIVX  D

 . I TYPE="DI",($P(^TMP($J,TYPE,PSIVX,0),U,4)="CRITICAL") S PSJIREQ=1

 . D WRITE(TYPE),CONT^PSGSICHK

 .; I ON["V" D

 .;. I '$O(^PS(55,DFN,"IV",+ON,0)) D SETPSJOC Q

 .;. D DSPLORDV(DFN,ON) S PSJOC=PSJOC+1

 .; I ON'["V" D DSPLORDU(DFN,ON) S PSJOC=PSJOC+1

 .; S PSJOC(ON,PSJLINE)="",PSJLINE=PSJLINE+1

 ;D:PSJOC WRITE(TYPE)

 ;S ON="" F  S ON=$O(PSJOC(ON)) Q:ON=""  W ! S PSJLINE=PSJLINE+1 D

 ;. F PSIVX=0:0 S PSIVX=$O(PSJOC(ON,PSIVX)) Q:'PSIVX  W !,PSJOC(ON,PSIVX)  S PSJLINE=PSJLINE+1 D:'(PSIVX#6) PAUSE

 ;W !

 Q

WRITE(TYPE) ;Display order check description

 S PSJPDRG=1

 I TYPE="DD" W !!,"There are duplicate ",$P(^TMP($J,TYPE,PSIVX,0),U,2),!,"medications prescribed for this order.",! Q

 I TYPE="DC" W !!,"This medication: ",$P(^TMP($J,TYPE,PSIVX,0),U,4),!,"is in the same class as the following medication(s) within this order: "

 I TYPE="DI" W !!,"This medication: ",$P(^TMP($J,TYPE,PSIVX,0),U,2),!,"has an interaction with the following medication(s) within this order: "

 F X=0:0 S X=$O(^TMP($J,TYPE,X)) Q:'X  W !,$S(TYPE="DC":$P(^TMP($J,TYPE,X,0),U,4),TYPE="DI":$P(^TMP($J,TYPE,X,0),U,6),1:$P(^TMP($J,TYPE,X,0),U,2)),!

 Q

PSJLIFNI  ;BIR/MV-U/D ORDER FINISHES AS IV ;13 Jan 98 / 11:32 AM

 +1       ;;5.0; INPATIENT MEDICATIONS ;**1,29,34,37,50,94,116,110,111**;16 DEC 97

 +2       ;

IV(PSJORD,OI) ; Prompt for missing data to be finished as IV.

 +1        LOCK +^PS(53.1,+PSJORD):1

           IF '$TEST

               WRITE !,$CHAR(7),$CHAR(7),"This order is being edited by another user. Try later."

               DO PAUSE^VALM1

               QUIT 

 +2        DO HOLDHDR^PSJOE

 +3       ;** PSIVFN1 is use so it will dipslay the AC/Edit screen

 +4       ;** instead of go to the "IS this O.K." prompt

 +5       ;** PSJLIFNI is a flag to indicate U/D finishes as IV.

 +6        KILL PSJIVBD

 +7        NEW PSIVFN1,ON55,PSGORQF,PSIVACEP,DRGOC,PSJLIFNI,PSIVOI

 +8        SET PSJLIFNI=1

 +9        SET PSIVAC="CF"

           SET (P("PON"),ON,ON55)=+PSJORD_"P"

           SET DFN=PSGP

 +10       SET PSIVUP=+$$GTPCI^PSIVUTL

           DO GT531^PSIVORFA(DFN,ON)

           SET P("PD")=OI_U_$$OIDF^PSJLMUT1(+OI)

 +11       IF '$DATA(P("OT"))

               DO GTOT^PSIVUTL(P(4))

 +12       SET P("OPI")=$$ENPC^PSJUTL("V",+PSIVUP,60,P("OPI"))

 +13       DO 53^PSIVORC1

 +14       IF $EXTRACT(P("OT"))="I"

               DO GTDATA^PSJLIFN

               IF P(4)=""

                   QUIT 

 +15      ;I $$SCHREQ^PSJLIVFD(.P),(P(9))]"",'$$PRNOK^PSGS0(P(9)) N PSGOES,X,PSGS0XT,PSJNSS S PSJNSS=1,PSGOES=1,X=P(9),PSGS0XT=P(15) D Q2^PSGS0

 +16       IF $$SCHREQ^PSJLIVFD(.P)

               IF (P(9))]""

                   IF '$$PRNOK^PSGS0(P(9))

                       NEW PSJNSS,PSGOES,PSGS0XT,PSGS0Y,PSGAT

                       SET X=P(9)

                       SET PSGS0XT=P(15)

                       SET PSGAT=P(11)

                       Begin DoDot:1

 +17                       DO EN^PSGS0

                           IF $GET(X)=""

                               SET PSGORQF=1

                               QUIT 

 +18                       IF $GET(PSGS0Y)>1

                               SET P(11)=PSGS0Y

                       End DoDot:1

 +19       IF $EXTRACT(P("OT"))="I"

               IF '$DATA(DRG("AD"))

                   IF ('$DATA(DRG("SOL")))

                       SET DNE=0

                       DO GTIVDRG^PSIVORC2

                       SET P(3)=""

                       DO ENSTOP^PSIVCAL

                       DO ORDCHK^PSJLIFN

 +20       IF $DATA(PSGORQF)

               SET VALMBCK="R"

               SET P(4)=""

               KILL DRG

               QUIT 

 +21       SET ^TMP("PSJI",$JOB,0)=""

 +22       SET PSIVOK="1^3^10^25^26^39^57^58^59^63^64"

           DO CKFLDS^PSIVORC1

           IF EDIT]""

               DO EDIT^PSIVEDT

 +23       IF $GET(DONE)

               SET VALMBCK="R"

               DO EXIT

               QUIT 

 +24       DO COMPLTE^PSIVORC1

 +25       IF $DATA(PSIVACEP)

               SET VALMBCK="Q"

EXIT      ;

 +1        LOCK -^PS(53.1,+PSJORD)

 +2        QUIT 

ORDCHK(DFN,TYPE) ;

 +1       ;TYPE ="DD" - Duplicate drug

 +2       ;     ="DC" - Duplicate class

 +3       ;     -"DI" - Drug Interaction

 +4       ;

 +5        NEW ON,PSJL,PSIVX,PSJOC,PSJORIEN,PSJPACK,PSJLINE

 +6        SET PSJOC=0

           SET PSJLINE=1

 +7        FOR PSIVX=0:0

               SET PSIVX=$ORDER(^TMP($JOB,TYPE,PSIVX))

               IF 'PSIVX

                   QUIT 

               Begin DoDot:1

 +8                IF TYPE="DI"

                       IF ($PIECE(^TMP($JOB,TYPE,PSIVX,0),U,4)="CRITICAL")

                           SET PSJIREQ=1

 +9                DO WRITE(TYPE)

                   DO CONT^PSGSICHK

 +10      ; I ON["V" D

 +11      ;. I '$O(^PS(55,DFN,"IV",+ON,0)) D SETPSJOC Q

 +12      ;. D DSPLORDV(DFN,ON) S PSJOC=PSJOC+1

 +13      ; I ON'["V" D DSPLORDU(DFN,ON) S PSJOC=PSJOC+1

 +14      ; S PSJOC(ON,PSJLINE)="",PSJLINE=PSJLINE+1

               End DoDot:1

 +15      ;D:PSJOC WRITE(TYPE)

 +16      ;S ON="" F  S ON=$O(PSJOC(ON)) Q:ON=""  W ! S PSJLINE=PSJLINE+1 D

 +17      ;. F PSIVX=0:0 S PSIVX=$O(PSJOC(ON,PSIVX)) Q:'PSIVX  W !,PSJOC(ON,PSIVX)  S PSJLINE=PSJLINE+1 D:'(PSIVX#6) PAUSE

 +18      ;W !

 +19       QUIT 

WRITE(TYPE) ;Display order check description

 +1        SET PSJPDRG=1

 +2        IF TYPE="DD"

               WRITE !!,"There are duplicate ",$PIECE(^TMP($JOB,TYPE,PSIVX,0),U,2),!,"medications prescribed for this order.",!

               QUIT 

 +3        IF TYPE="DC"

               WRITE !!,"This medication: ",$PIECE(^TMP($JOB,TYPE,PSIVX,0),U,4),!,"is in the same class as the following medication(s) within this order: "

 +4        IF TYPE="DI"

               WRITE !!,"This medication: ",$PIECE(^TMP($JOB,TYPE,PSIVX,0),U,2),!,"has an interaction with the following medication(s) within this order: "

 +5        FOR X=0:0

               SET X=$ORDER(^TMP($JOB,TYPE,X))

               IF 'X

                   QUIT 

               WRITE !,$SELECT(TYPE="DC":$PIECE(^TMP($JOB,TYPE,X,0),U,4),TYPE="DI":$PIECE(^TMP($JOB,TYPE,X,0),U,6),1:$PIECE(^TMP($JOB,TYPE,X,0),U,2)),!

 +6        QUIT