| [613] | 1 | PSGCAPIV ;BIR/MV-ACTION PROFILE #2 IV ORDERS ;07 Apr 98 / 1:10 PM
|
|---|
| 2 | ;;5.0; INPATIENT MEDICATIONS ;**9,58,169**;16 DEC 97
|
|---|
| 3 | ;
|
|---|
| 4 | ; Reference to ^PS(52.6 is supported by DBIA# 1231
|
|---|
| 5 | ; Reference to ^PS(52.7 is supported by DBIA# 2173
|
|---|
| 6 | ; Reference to ^PS(55 is supported by DBIA# 2191
|
|---|
| 7 | ;
|
|---|
| 8 | START ;
|
|---|
| 9 | NEW P,ON,DRG S ON=""
|
|---|
| 10 | ;* S:PSGSS'="P" PSGDT=PSGAPSD-.0001 S:PSGSS="P" STP=9999999
|
|---|
| 11 | S PSGDT=PSGAPSD-.0001
|
|---|
| 12 | F PSGEXPDT=PSGDT:0 S PSGEXPDT=$O(^PS(55,PSGP,"IV","AIT",PST,PSGEXPDT)) Q:$S('PSGEXPDT:1,PSGAPO="E":PSGEXPDT>PSGAPFD,1:0) F S ON=$O(^PS(55,PSGP,"IV","AIT",PST,PSGEXPDT,ON)) Q:ON="" D IV
|
|---|
| 13 | Q
|
|---|
| 14 | IV ;
|
|---|
| 15 | N X,ON55 S DFN=PSGP D GT55^PSIVORFB
|
|---|
| 16 | Q:"DE"[P(17)
|
|---|
| 17 | S X=$P(P("MR"),U,2) Q:XTYPE=2&(X["IV") Q:XTYPE=3&(PST="S")&'($S(X="IV":1,X="IVPB":1,1:0))
|
|---|
| 18 | S QST=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3))
|
|---|
| 19 | I QST'="O" S QST=$S(P(9)["PRN":"P",1:"C")
|
|---|
| 20 | I DRG S X=$S($G(DRG("AD",1)):DRG("AD",1),1:$G(DRG("SOL",1))),DRG=$S(P(4)="H":"* TPN *",1:$E($$ENPDN^PSGMI($P(X,U,6)),1,20))
|
|---|
| 21 | S ^TMP($J,S1,PSGAPWDN,PN,QST_U_$E(DRG,1,20),ON_"V")=""
|
|---|
| 22 | Q
|
|---|
| 23 | PRT(ON) ;*** Print IV orders.
|
|---|
| 24 | NEW TYPE S TYPE=$P(DRG,U),ON=+ON,DCU=0
|
|---|
| 25 | N ON55,DRG,P,PRTST S DFN=PSGP,PRTST=1 D GT55^PSIVORFB
|
|---|
| 26 | F X=2,3 S:P(X) P(X)=$E($$ENDTC^PSGMI(P(X)),1,5)
|
|---|
| 27 | S PSJSI=$$ENSET^PSGSICHK($P(P("OPI"),"^"))
|
|---|
| 28 | ;PSJ*5*169 Set QST so one-time orders will not allow RENEW on report.
|
|---|
| 29 | N QST
|
|---|
| 30 | S QST=$$ONE^PSJBCMA(DFN,ON,P(9),P(2),P(3))
|
|---|
| 31 | I QST'="O" S QST=$S(P(9)["PRN":"P",1:"C")
|
|---|
| 32 | W !,$J(N,3)
|
|---|
| 33 | I '$O(DRG("AD",0)) D PRTST W !
|
|---|
| 34 | I $O(DRG("AD",0)) F X=0:0 S X=$O(DRG("AD",X)) Q:'X W ?5,$$WRTDRG^PSIVUTL(DRG("AD",X),41) D:X=1 PRTST D DCU("AD",X),NP("AD") G:$G(PSJDLW) EXIT W !
|
|---|
| 35 | W ?5,"in "
|
|---|
| 36 | F X=0:0 S X=$O(DRG("SOL",X)) Q:'X D:X>1 NP("SOL") W:X>1 ! W ?8,$$WRTDRG^PSIVUTL(DRG("SOL",X),41) D DCU("SOL",X) G:$G(PSJDLW) EXIT
|
|---|
| 37 | W:P(9)]"" " " W P(9)," ",P(8) D:'$G(DRG("AD",1))&PRTST PRTST
|
|---|
| 38 | I PSJSI]"" W !?5,"Special Instructions: " F Y=1:1:$L(PSJSI," ") S Y1=$P(PSJSI," ",Y) W:($L(Y1)+$X)>79 !?27 W Y1_" "
|
|---|
| 39 | W ! D ORDP1^PSGCAPP
|
|---|
| 40 | Q
|
|---|
| 41 | PRTST ;*** Print the rest of the 1st line.
|
|---|
| 42 | W:PRTST ?46,TYPE,?49,P(2),?55,P(3),?61,P(17)
|
|---|
| 43 | S PRTST=0
|
|---|
| 44 | Q
|
|---|
| 45 | NP(TYPE) ;*** Print end line after order.
|
|---|
| 46 | NEW X
|
|---|
| 47 | D:DRG(TYPE,0)>1&($Y+11>IOSL) NP^PSGCAPP
|
|---|
| 48 | Q
|
|---|
| 49 | DCU(TYPE,X) ;*** Calculate drug cost.
|
|---|
| 50 | NEW COST
|
|---|
| 51 | S:TYPE="AD" COST=$P(^PS(52.6,+DRG(TYPE,X),0),U,7)
|
|---|
| 52 | S:TYPE="SOL" COST=$P(^PS(52.7,+DRG(TYPE,X),0),U,7)
|
|---|
| 53 | S DCU=DCU+(COST*+$P(DRG(TYPE,X),U,3))
|
|---|
| 54 | Q
|
|---|
| 55 | EXIT ;
|
|---|
| 56 | Q
|
|---|
