PSSQOC.m

PSSQOC ;BIR/MLM-CONVERT PSJ 4.5 QUICK ORDERS FOR USE IN OE/RR 3.0 ;09/09/97

 ;;1.0;PHARMACY DATA MANAGEMENT;*100,123*;9/30/97;Build 6

 ;External reference to ^ORD(101 supported by DBIA 872

 ;External reference to ^PS(57.1 supported by DBIA 2139

 ;

EN(PROTIEN)        ;

 N DD,OI,ND0,ND1,PSJBAD,TVOLUME,X S (PSJBAD,TVOLUME)=0 K ^TMP("PSJQO",$J)

 S PSJQOPTR=+$E($P($P($G(^ORD(101,+PROTIEN,0)),U)," "),5,99)

 S ND0=$G(^PS(57.1,PSJQOPTR,0)),ND1=$G(^(1)) I ND0=""!(ND1="") Q

 I $P(ND0,U,3)'=1,$P(ND0,U,3)'=2 Q

 D @$P(ND0,U,3) Q:'OI

 S ^TMP("PSJQO",$J,1)=$P(ND0,U)_U_$P(ND0,U,3)_U_OI_U_$P(ND1,U,2,6)

 S:$G(DD) ^TMP("PSJQO",$J,"DD")=DD

 D GTPC

 ;  check infusion rate

 S X=$P(ND1,"^",5) I $G(X) D

 .D ENI K FREQ I '$D(X) S PSJBAD=1

 .E  S $P(^TMP("PSJQO",$J,1),"^",7)=X

 K:PSJBAD=1 ^TMP("PSJQO",$J)

 Q

 ;

1 ; Convert IV Fluid Quick Order

 S CNT=0 F X=0:0 S X=$O(^PS(57.1,PSJQOPTR,3,X)) Q:'X  D

 .S Y=$G(^PS(52.6,+$G(^PS(57.1,PSJQOPTR,3,X,0)),0)),OI=$P(Y,U,11)

 .S UNITS=$P("ML^LITER^MCG^MG^GM^UNITS^IU^MEQ^MM^MU^THOUU^MG-PE^NANOGRAM^MMOL",U,+$P(Y,U,3))

 .I OI]"" S CNT=CNT+1

 .I  S ^TMP("PSJQO",$J,"AD",CNT,0)=OI_U_+$P($G(^PS(57.1,PSJQOPTR,3,X,0)),"^",2)_U_UNITS

 I CNT S ^TMP("PSJQO",$J,"AD",0)=CNT_U_CNT

 S CNT=0 F X=0:0 S X=$O(^PS(57.1,PSJQOPTR,4,X)) Q:'X  D

 .S Y=$G(^PS(52.7,+$G(^PS(57.1,PSJQOPTR,4,X,0)),0)),OI=$P(Y,U,11)

 .N VOL S VOL=$P($G(^PS(57.1,PSJQOPTR,4,X,0)),"^",2)

 .S TVOLUME=TVOLUME++VOL

 .I (VOL'=+VOL)&(VOL'?1.6N1" "1"ML") S PSJBAD=1

 .I OI]"" S CNT=CNT+1

 .I  S ^TMP("PSJQO",$J,"SOL",CNT,0)=OI_U_VOL

 I CNT S ^TMP("PSJQO",$J,"SOL",0)=CNT_U_CNT

 Q

2 ;

 S OI="",PD=+ND1

 F DD=0:0 S DD=$O(^PSDRUG("AP",PD,DD)) Q:'DD  I $G(^PSDRUG(DD,"I"))=""!($G(^PSDRUG(DD,"I"))>DT) S OI=+$G(^PSDRUG(DD,2))

 I '$O(^PSDRUG("AP",PD,DD)) S ^TMP("PSJQO",$J,"DD")=DD Q

 S MATCH=1 F  S DD=$O(^PSDRUG("AP",PD,DD)) Q:'DD!'MATCH  D

 .I ($G(^PSDRUG(DD,"I"))=""!($G(^PSDRUG(DD,"I"))>DT))&(+$G(^PSDRUG(DD,2))'=OI) S MATCH=0 Q

 S:'MATCH OI=""

 Q

 ;

 ;

GTPC ; Set up TMP for provider comments    

 I $O(^PS(57.1,+PSJQOPTR,2,0))  D

 .S CNT=0 F X=0:0 S X=$O(^PS(57.1,+PSJQOPTR,2,X)) Q:'X  D

 ..S Y=$G(^PS(57.1,PSJQOPTR,2,X,0)) S:Y]"" CNT=CNT+1,^TMP("PSJQO",$J,"PC",CNT,0)=Y

 .S:$O(^TMP("PSJQO",$J,"PC",0)) ^TMP("PSJQO",$J,"PC",0)=CNT_U_CNT

 Q

ENI ;Calculate Frequency for IV orders

 K:$L(X)<1!($L(X)>30)!(X["""")!($A(X)=45) X I '$D(X) Q

 I X'=+X,($P(X,"@",2,999)'=+$P(X,"@",2,999)!(+$P(X,"@",2,999)<0)),($P(X," ml/hr")'=+$P(X," ml/hr")!(+$P(X," ml/hr")<0)) K X Q

 I X=+X S X=X_" ml/hr" D SPSOL S FREQ=$S('X:0,1:SPSOL\X*60+(SPSOL#X/X*60+.5)\1) K SPSOL Q

 I X[" ml/hr" D SPSOL S FREQ=$S('X:0,1:SPSOL\X*60+(SPSOL#X/X*60+.5)\1) K SPSOL Q

 S SPSOL=$P(X,"@",2) S:$P(X,"@")=+X $P(X,"@")=$P(X,"@")_" ml/hr" S FREQ=$S('SPSOL:0,1:1440/SPSOL\1) K SPSOL

 Q

SPSOL S SPSOL=+TVOLUME Q

PSSQOC    ;BIR/MLM-CONVERT PSJ 4.5 QUICK ORDERS FOR USE IN OE/RR 3.0 ;09/09/97

 +1       ;;1.0;PHARMACY DATA MANAGEMENT;*100,123*;9/30/97;Build 6

 +2       ;External reference to ^ORD(101 supported by DBIA 872

 +3       ;External reference to ^PS(57.1 supported by DBIA 2139

 +4       ;

EN(PROTIEN) ;

 +1        NEW DD,OI,ND0,ND1,PSJBAD,TVOLUME,X

           SET (PSJBAD,TVOLUME)=0

           KILL ^TMP("PSJQO",$JOB)

 +2        SET PSJQOPTR=+$EXTRACT($PIECE($PIECE($GET(^ORD(101,+PROTIEN,0)),U)," "),5,99)

 +3        SET ND0=$GET(^PS(57.1,PSJQOPTR,0))

           SET ND1=$GET(^(1))

           IF ND0=""!(ND1="")

               QUIT 

 +4        IF $PIECE(ND0,U,3)'=1

               IF $PIECE(ND0,U,3)'=2

                   QUIT 

 +5        DO @$PIECE(ND0,U,3)

           IF 'OI

               QUIT 

 +6        SET ^TMP("PSJQO",$JOB,1)=$PIECE(ND0,U)_U_$PIECE(ND0,U,3)_U_OI_U_$PIECE(ND1,U,2,6)

 +7        IF $GET(DD)

               SET ^TMP("PSJQO",$JOB,"DD")=DD

 +8        DO GTPC

 +9       ;  check infusion rate

 +10       SET X=$PIECE(ND1,"^",5)

           IF $GET(X)

               Begin DoDot:1

 +11               DO ENI

                   KILL FREQ

                   IF '$DATA(X)

                       SET PSJBAD=1

 +12              IF '$TEST

                       SET $PIECE(^TMP("PSJQO",$JOB,1),"^",7)=X

               End DoDot:1

 +13       IF PSJBAD=1

               KILL ^TMP("PSJQO",$JOB)

 +14       QUIT 

 +15      ;

1         ; Convert IV Fluid Quick Order

 +1        SET CNT=0

           FOR X=0:0

               SET X=$ORDER(^PS(57.1,PSJQOPTR,3,X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +2                SET Y=$GET(^PS(52.6,+$GET(^PS(57.1,PSJQOPTR,3,X,0)),0))

                   SET OI=$PIECE(Y,U,11)

 +3                SET UNITS=$PIECE("ML^LITER^MCG^MG^GM^UNITS^IU^MEQ^MM^MU^THOUU^MG-PE^NANOGRAM^MMOL",U,+$PIECE(Y,U,3))

 +4                IF OI]""

                       SET CNT=CNT+1

 +5               IF $TEST

                       SET ^TMP("PSJQO",$JOB,"AD",CNT,0)=OI_U_+$PIECE($GET(^PS(57.1,PSJQOPTR,3,X,0)),"^",2)_U_UNITS

               End DoDot:1

 +6        IF CNT

               SET ^TMP("PSJQO",$JOB,"AD",0)=CNT_U_CNT

 +7        SET CNT=0

           FOR X=0:0

               SET X=$ORDER(^PS(57.1,PSJQOPTR,4,X))

               IF 'X

                   QUIT 

               Begin DoDot:1

 +8                SET Y=$GET(^PS(52.7,+$GET(^PS(57.1,PSJQOPTR,4,X,0)),0))

                   SET OI=$PIECE(Y,U,11)

 +9                NEW VOL

                   SET VOL=$PIECE($GET(^PS(57.1,PSJQOPTR,4,X,0)),"^",2)

 +10               SET TVOLUME=TVOLUME++VOL

 +11               IF (VOL'=+VOL)&(VOL'?1.6N1" "1"ML")

                       SET PSJBAD=1

 +12               IF OI]""

                       SET CNT=CNT+1

 +13              IF $TEST

                       SET ^TMP("PSJQO",$JOB,"SOL",CNT,0)=OI_U_VOL

               End DoDot:1

 +14       IF CNT

               SET ^TMP("PSJQO",$JOB,"SOL",0)=CNT_U_CNT

 +15       QUIT 

2         ;

 +1        SET OI=""

           SET PD=+ND1

 +2        FOR DD=0:0

               SET DD=$ORDER(^PSDRUG("AP",PD,DD))

               IF 'DD

                   QUIT 

               IF $GET(^PSDRUG(DD,"I"))=""!($GET(^PSDRUG(DD,"I"))>DT)

                   SET OI=+$GET(^PSDRUG(DD,2))

 +3        IF '$ORDER(^PSDRUG("AP",PD,DD))

               SET ^TMP("PSJQO",$JOB,"DD")=DD

               QUIT 

 +4        SET MATCH=1

           FOR 

               SET DD=$ORDER(^PSDRUG("AP",PD,DD))

               IF 'DD!'MATCH

                   QUIT 

               Begin DoDot:1

 +5                IF ($GET(^PSDRUG(DD,"I"))=""!($GET(^PSDRUG(DD,"I"))>DT))&(+$GET(^PSDRUG(DD,2))'=OI)

                       SET MATCH=0

                       QUIT 

               End DoDot:1

 +6        IF 'MATCH

               SET OI=""

 +7        QUIT 

 +8       ;

 +9       ;

GTPC      ; Set up TMP for provider comments    

 +1        IF $ORDER(^PS(57.1,+PSJQOPTR,2,0))

               Begin DoDot:1

 +2                SET CNT=0

                   FOR X=0:0

                       SET X=$ORDER(^PS(57.1,+PSJQOPTR,2,X))

                       IF 'X

                           QUIT 

                       Begin DoDot:2

 +3                        SET Y=$GET(^PS(57.1,PSJQOPTR,2,X,0))

                           IF Y]""

                               SET CNT=CNT+1

                               SET ^TMP("PSJQO",$JOB,"PC",CNT,0)=Y

                       End DoDot:2

 +4                IF $ORDER(^TMP("PSJQO",$JOB,"PC",0))

                       SET ^TMP("PSJQO",$JOB,"PC",0)=CNT_U_CNT

               End DoDot:1

 +5        QUIT 

ENI       ;Calculate Frequency for IV orders

 +1        IF $LENGTH(X)<1!($LENGTH(X)>30)!(X["""")!($ASCII(X)=45)

               KILL X

           IF '$DATA(X)

               QUIT 

 +2        IF X'=+X

               IF ($PIECE(X,"@",2,999)'=+$PIECE(X,"@",2,999)!(+$PIECE(X,"@",2,999)<0))

                   IF ($PIECE(X," ml/hr")'=+$PIECE(X," ml/hr")!(+$PIECE(X," ml/hr")<0))

                       KILL X

                       QUIT 

 +3        IF X=+X

               SET X=X_" ml/hr"

               DO SPSOL

               SET FREQ=$SELECT('X:0,1:SPSOL\X*60+(SPSOL#X/X*60+.5)\1)

               KILL SPSOL

               QUIT 

 +4        IF X[" ml/hr"

               DO SPSOL

               SET FREQ=$SELECT('X:0,1:SPSOL\X*60+(SPSOL#X/X*60+.5)\1)

               KILL SPSOL

               QUIT 

 +5        SET SPSOL=$PIECE(X,"@",2)

           IF $PIECE(X,"@")=+X

               SET $PIECE(X,"@")=$PIECE(X,"@")_" ml/hr"

           SET FREQ=$SELECT('SPSOL:0,1:1440/SPSOL\1)

           KILL SPSOL

 +6        QUIT 

SPSOL      SET SPSOL=+TVOLUME

           QUIT