PSIVSTAT ;BIR/PR-BUILD COST TRANS NODE, ENTER COMPILE ;6 Nov 98 / 4:45 PM
 ;;5.0; INPATIENT MEDICATIONS ;**3,18,84,81,104,111,130**;16 DEC 97
 ;
 ; Reference to ^ECXPIV1 is supported by DBIA# 1882.
 ; Reference to ^PS(52.6 is supported by DBIA# 1231.
 ; Reference to ^PS(52.7 is supported by DBIA# 2173.
 ; Reference to ^PS(55 is supported by DBIA# 2191.
 ; 
 ;Needs dfn,on,psivnol,psivc (optional:dis/ret/des).
 ;
 S PSIVV=1 L +^PS(50.8,PSIVSN):5000
 I '$G(PSIVC) S PSIVC=$S(($G(PSJRDC)="R"):2,($G(PSJRDC)="D"):3,($G(PSJRDC)]""):4,1:1)
 ;D NOW^%DTC S (Y,PSIVNOW)=% I '$D(^PS(50.8,PSIVSN,0)) L +^PS(50.8,0) S ^PS(50.8,PSIVSN,0)=PSIVSN,$P(^(0),U,3,4)=PSIVSN_U_($P(^PS(50.8,0),U,4)+1) L -^PS(50.8,0)
 D NOW^%DTC S (Y,PSIVNOW)=% I '$D(^PS(50.8,PSIVSN,0)) D  S ^PS(50.8,PSIVSN,0)=PSIVSN,$P(^(0),U,3,4)=PSIVSN_U_($P(^PS(50.8,0),U,4)+1) L -^PS(50.8,0)
 .F  L +^PS(50.8,0):1 Q:$T
 S $P(^PS(50.8,PSIVSN,1,0),U,1,3)="^50.801P^"_DFN S:'$D(^(DFN,0)) ^(0)=DFN,$P(^(0),U,3,4)=DFN_U_($P(^PS(50.8,PSIVSN,1,0),U,4)+1)
 S PSIVTN=1 I $D(^PS(50.8,PSIVSN,1,DFN,1,0)) F PSIVTN=$P(^(0),U,3)+1:1 Q:'$D(^PS(50.8,PSIVSN,1,DFN,1,PSIVTN,0))
 ;
RETDET ;Get the ward that returns or destroyed need to be associated with.
 ;RDFLAG & RDWARD ARE set in routine PSIVRD.
 I $D(RDFLAG) S PSIVWD=RDWARD S:'$D(^PS(55,DFN,"IV",+ON,9)) $P(^(9),U,1,2)="" S $P(^(9),U,3)=$P(^(9),U,3)-PSIVNOL G SKIP
 ;
LBWD ;Get the ward we that we are printing labels on.
 S PSIVWD=$P(^PS(55,DFN,"IV",+ON,0),U,22) G:PSIVWD SKIP
 S PSIVWD=$S($D(^DPT(DFN,.1)):$O(^DIC(42,"B",^DPT(DFN,.1),0)),1:.5)
 ;
SKIP ;
 ;Set up the transaction node here.
 S ^PS(50.8,PSIVSN,1,DFN,1,0)="^50.802^"_PSIVTN_U_PSIVTN,^(PSIVTN,0)=PSIVTN_U_+ON_U_PSIVC_U_PSIVNOW_U_PSIVNOL_U_PSIVWD
 ;
DSS ; Update DSS for IV extract
 ;
 S X="ECXPIV1" X ^%ZOSF("TEST") Q:'$T
 N ADSTR,ADUNITS,DCST,DDRG,DRG,PROV,SOLSTR,TYP,START,IVROOM,DSDATE,A,B
 K ^TMP($J)
 S X=$G(^PS(55,DFN,"IV",+ON,0)),PROV=$P(X,U,6),TYP=$P(X,U,4),START=$P(X,U,2)
 S A=$G(^PS(55,DFN,"IV",+ON,2)),IVROOM=$P(A,"^",2),B=$G(^PS(55,DFN,"IV",+ON,4)),DSDATE=$S($P(B,"^",2)]"":$P(B,"^",2),1:$P(A,"^"))
 F DRGTYP="AD","SOL" F DRG=0:0 S DRG=$O(^PS(55,DFN,"IV",+ON,DRGTYP,DRG)) Q:'DRG  D
 .S ND=$G(^PS(55,DFN,"IV",+ON,DRGTYP,DRG,0)),(ADSTR,ADUNITS,SOLSTR)=""
 .S @(DRGTYP_"STR")=$P(ND,U,2),ND=$G(^PS($S(DRGTYP="AD":52.6,1:52.7),+ND,0)),DDRG=$P(ND,U,2),DCST=$P(ND,U,7)
 .I DRGTYP="AD" S Y=$P(ND,U,3) I Y S Y=$$CODES^PSIVUTL(Y,52.6,2) S ADUNITS=Y
 .S ECUD=DFN_U_+ON_U_DDRG_U_PSIVNOW_U_PSIVC_U_ADSTR_U_ADUNITS_U_+SOLSTR_U_PROV_U_TYP_U_DCST
 .S ECUD=ECUD_U_$P($G(^PS(55,DFN,"IV",+ON,"DSS")),"^")_U_START_U_IVROOM_U_DSDATE S ^TMP($J,DFN,ON,DDRG)=ECUD D ^ECXPIV1
Q1 L -^PS(50.8,PSIVSN) K PSIVD,PSIVTN,PSIVV,PSIVWD,PSIVLP Q
 ;
EN ;Compile IV stats hold file here.
 I $D(PSIVSITE),$D(PSIVSN) K ZTSAVE S ZTDTH=$H,ZTDESC="COMPILE IV STATS (FROM MENU)",ZTRTN="EN^PSIVSTAT",ZTIO="" D ^%ZTLOAD W:$D(ZTSK) !,"Queued." G Q
 ;K ^TMP("PSIVNC",$J) S PSIVV=1,X="T-"_$S(+$G(^PS(59.7,1,31)):+^(31),1:100),%DT="" D ^%DT
 ;F X=0:0 S X=$O(^PS(50.8,X)) Q:'X  F I=0:0 S I=$O(^PS(50.8,X,2,I)) Q:'I  I I<Y K ^PS(50.8,X,2,I) S $P(^(0),U,4)=$P(^(0),U,4)-1
 K ^TMP("PSIVNC",$J) F Q=0:0 S Q=$O(^PS(50.8,Q)) Q:'Q  D
 .S X="T-"_$S($P($G(^PS(59.5,Q,1)),U,19):$P(^(1),U,19),1:100) D ^%DT
 .F I=0:0 S I=$O(^PS(50.8,Q,2,I)) Q:'I  I I<Y K ^PS(50.8,Q,2,I) S $P(^(0),U,4)=$P(^(0),U,4)-1
 ;F PSIVS=0:0 S PSIVS=$O(^PS(50.8,PSIVS)) Q:'PSIVS  L +^PS(50.8,PSIVS,0) D CNT L -^PS(50.8,PSIVS,0)
 F PSIVS=0:0 S PSIVS=$O(^PS(50.8,PSIVS)) Q:'PSIVS  D  D CNT L -^PS(50.8,PSIVS,0)
 .F  L +^PS(50.8,PSIVS,0):1 Q:$T
Q K D,PSGDT,PSIVNOL,PSIVD,PSIVC,PSIVS,PSIVV,%DT,Z,ZTSK,DFN,PSIV,PNL,POP,LO,IV,PSIVDG,PSIVDRG D ENIVKV^PSGSETU Q
CNT F DFN=0:0 S DFN=$O(^PS(50.8,PSIVS,1,DFN)) Q:'DFN  F TN=0:0 S TN=$O(^PS(50.8,PSIVS,1,DFN,1,TN)) Q:'TN  D SET
 S:$D(ZTQUEUED) ZTREQ="@" I $D(^TMP("PSIVNC",$J)) D MSG K TN,ZTIO,ZTRTN,X,Y Q
 K ^PS(50.8,PSIVS,1),TN,ZTIO,ZTRTN,X,Y Q
SET S TN=^PS(50.8,PSIVS,1,DFN,1,TN,0),ON=$P(TN,U,2),PSIVC=$P(TN,U,3),PSIVNOL=$P(TN,U,5),W42=$P(TN,U,6),PSIVD=$P(TN,U,4)\1
 F PSIVDG=52.6,52.7 F I=0:0 S I=$O(^PS(55,DFN,"IV",+ON,$S(PSIVDG=52.6:"AD",1:"SOL"),I)) Q:'I!($D(NON))  S PSIVDRG=+^(I,0) I $P(^PS(PSIVDG,PSIVDRG,0),U,7)="" S NON=1 D NOCOST
 I $D(NON) K PSIVDG,PSIVDRG,NON Q
 D ^PSIVST2 K ^PS(50.8,PSIVS,1,DFN,1,+TN) Q
NOCOST ;Send message if the drug is missing a unit cost.
 ;
 S $P(^PS(50.8,PSIVS,1,DFN,1,+TN,0),U,7)=PSIVDG_";"_PSIVDRG,NUM=$S('$D(NUM):1,1:NUM+1),^TMP($J,"PSIVNC",NUM,0)=$P(^PS(PSIVDG,PSIVDRG,0),U)_" IN THE "_$S(PSIVDG=52.6:"ADDITIVES",1:"SOLUTIONS")_" FILE." Q
MSG S XMDUZ="IV PHARMACY PACKAGE",XMSUB="MISSING COST INFORMATION",XMTEXT="^TMP(""PSIVNC"",$J,"
 F PSIVDUZ=0:0 S PSIVDUZ=$O(^XUSEC("PSJI MGR",PSIVDUZ)) Q:'PSIVDUZ  S XMY(PSIVDUZ)=""
 D ^XMD K TMP("PSIVNC",$J),XMY,XMDUZ,NUM,XMTEXT,PSIVDUZ,XMSUB
 Q