- APCMVAEM ; IHS/CMI/LAB - V2 MED BY PROV SUB RTN KFOX ;
- ;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65
- START ;Set beginning/ending sort dates for ORDERS
- S %DT="AE",%DT("A")="Enter Start Date range: " D ^%DT
- I (Y'>0)!(X["^")!(X="") D EXIT Q
- S CPSTART=Y
- K %DT,%DT("A"),X,Y
- S Y=CPSTART D DD^%DT S CPSTART(0)=Y
- ;
- S %DT="AE",%DT("A")="Enter Ending Date range: " D ^%DT
- I (Y'>0)!(X["^")!(X="") D EXIT Q
- S CPSEND=Y
- K %DT,%DT("A"),X,Y
- S Y=CPSEND D DD^%DT S OEND(0)=Y
- S (CNT("UNIT DOSE","TR"),CNT("UNIT DOSE"))=0
- K ^TMP($J)
- P55 ; LOOP 55 UNIT DOSE
- S CPSDATE=CPSTART F S CPSDATE=$O(^PS(55,"AUDS",CPSDATE)) Q:CPSDATE>CPSEND!('+CPSDATE) D
- .S CPSDFN=0 F S CPSDFN=$O(^PS(55,"AUDS",CPSDATE,CPSDFN)) Q:'+CPSDFN D
- ..S CPS55=0 F S CPS55=$O(^PS(55,"AUDS",CPSDATE,CPSDFN,CPS55)) Q:'+CPS55 D
- ...;COUNT POSSIBLE DOSES DUE FOR ORDER.
- ...S CPSPOS=0
- ...S CPSFRE=$P($G(^PS(55,CPSDFN,5,+CPS55,2)),U,6),CPSTOP=$P($G(^PS(55,CPSDFN,5,+CPS55,2)),U,4),CPSSCH=$P($G(^PS(55,CPSDFN,5,+CPS55,0)),U,7)
- ...Q:CPSTOP<CPSDATE
- ...I CPSFRE="D"&(CPSSCH="C") S CPSN=$L($P($G(^PS(55,CPSDFN,5,+CPS55,2)),U,1),"-") S X2=CPSDATE,X1=$S(CPSTOP<DT:DT,1:CPSTOP) D ^%DTC S CPSPOS=CPSN*X
- ...I +CPSFRE&(CPSSCH="C") D
- ....S CPSS1=0,CPSS1=(24-$E($P(CPSDATE,".",2),1,2))*60 ;MINS FOR FIRST DATE
- ....IF CPSTOP>DT D NOW^%DTC S CPSS1=CPSS1+($E($P(%,".",2),1,2)*60) ; MINS FOR MIDNIGHT LAST DATE
- ....IF CPSTOP<DT S CPSS1=CPSS1+($E($P(CPSTOP,".",2),1,2)*60) ;MINS FOR MIDNIGHT LAST DATE
- ....S X1=CPSDATE,X2=+1 D C^%DTC S X2=X,X1=$S(CPSTOP>DT:DT,1:CPSTOP) D ^%DTC S CPSPOS=((X*1440)+CPSS1)/CPSFRE
- ....;S X1=DT,X2=+1 D C^%DTC S CPSNDT=X S X2=CPSDATE,X1=$S(CPSTOP>DT:CPSNDT,1:CPSTOP) D ^%DTC S CPSPOS=((X*1440)+CPSS1)/CPSFRE
- ...I CPSSCH="C"!(CPSSCH="P") S CNT("UNIT DOSE")=CNT("UNIT DOSE")+1
- ...;LOOK 53.79 FOR DOSE TRACKED.
- ...I CPSSCH="P" S CPSPOS=1 ;PRNS TO ONE
- ...Q:+CPSPOS<0!(CPSPOS=0)
- ...S CPSQ=$S(CPSSCH="P":1,CPSSCH="C":1,1:0)
- ...Q:CPSQ=0
- ...;W !,CPSSCH
- ...S (CPSPSB,CPSN1)=0 F S CPSN1=$O(^PSB(53.79,"AORDX",CPSDFN,CPS55_"U",CPSN1)) Q:'+CPSN1 S CPSPSB=CPSPSB+1
- ...Q:CPSPSB<CPSPOS
- ...S CNT("UNIT DOSE","TR")=CNT("UNIT DOSE","TR")+1 S ^TMP($J,"BCMA","TRUD",CPSDFN,CPS55)=CPSPOS_U_CPSPSB
- ...;W !,CPS55,U,CPSPOS,U,CPSPSB,U,CPSSCH
- IV ;LOOP IVS
- S (CNT("IV","TR"),CNT("IV"))=0
- S CPSDATE=CPSTART F S CPSDATE=$O(^PS(55,"AIVS",CPSDATE)) Q:CPSDATE>CPSEND!('+CPSDATE) D
- .S CPSDFN=0 F S CPSDFN=$O(^PS(55,"AIVS",CPSDATE,CPSDFN)) Q:'+CPSDFN D
- ..S CPS55=0 F S CPS55=$O(^PS(55,"AIVS",CPSDATE,CPSDFN,CPS55)) Q:'+CPS55 D
- ...S CNT("IV")=CNT("IV")+1,(CPSPSB,CPSPOS)=0
- ...S CPSTYPE=$P($G(^PS(55,CPSDFN,"IV",CPS55,0)),U,4)
- ...I CPSTYPE="P"!(CPSTYPE="S") D
- ....S CPSFRE=$P($G(^PS(55,CPSDFN,"IV",CPS55,0)),U,15) I +CPSFRE S CPSTOP=$P($G(^PS(55,CPSDFN,"IV",CPS55,0)),U,3) S X2=CPSDATE,X1=$S(CPSTOP<DT:DT,1:CPSTOP) D ^%DTC S CPSPOS=(X*1440)/CPSFRE
- ....I CPSFRE="O" S CPSPOS=1 ;ONCE
- ...;COUND TOTAL NUMBER OF IV BAGS FOR ORDER
- ...I $D(^PS(55,CPSDFN,"IV",+CPS55,"BCMA"))&(CPSTYPE'="P")&(CPSTYPE'="S") S (CPSPOS,CPSNUM)=0 F S CPSNUM=$O(^PS(55,CPSDFN,"IV",+CPS55,"BCMA",CPSNUM)) Q:'+CPSNUM S CPSPOS=CPSPOS+1
- ...;NO LABELS
- ...I '$D(^PS(55,CPSDFN,"IV",+CPS55,"BCMA"))&(CPSTYPE'="P")&(CPSTYPE'="S") D
- ....S CPSVOL=$P($G(^PS(55,CPSDFN,"IV",CPS55,"SOL",1,0)),U,2),CPSRAT=$P($G(^PS(55,CPSDFN,"IV",CPS55,0)),U,8)
- ....S CPSTOP=$P($G(^PS(55,CPSDFN,"IV",CPS55,0)),U,3)
- ....S CPSS1=0,CPSS1=(24-$E($P(CPSDATE,".",2),1,2))*60 ;MINS FOR FIRST DATE
- ....IF CPSTOP>DT D NOW^%DTC S CPSS1=CPSS1+($E($P(%,".",2),1,2)*60) ; MINS FOR MIDNIGHT LAST DATE
- ....IF CPSTOP<DT S CPSS1=CPSS1+($E($P(CPSTOP,".",2),1,2)*60) ;MINS FOR MIDNIGHT LAST DATE
- ....S X1=CPSDATE,X2=+1 D C^%DTC S X2=X,X1=$S(CPSTOP>DT:DT,1:CPSTOP) D ^%DTC S CPSPOS=(((((+CPSRAT*24)*X)+CPSS1)+CPSS1)\+CPSVOL)
- ...Q:'+CPSPOS&('+$G(CPSRAT)) ;NO POSSIBLE FOUND AND NO INFUSTION RATE BAIL THIS ONE.
- ...;LOOK IN BCMA FOR IVS
- ...S (CPSNUM,CPSPSB)=0 F S CPSNUM=$O(^PSB(53.79,"AUID",CPSDFN,CPS55_"V",CPSNUM)) Q:'+CPSNUM S CPSPSB=CPSPSB+1 D
- ....;W !,CPS55,U,CPSPOS,U,CPSPSB
- ....Q:CPSPSB<CPSPOS
- ....S CNT("IV","TR")=CNT("IV","TR")+1 S ^TMP($J,"BCMA","IV",CPSDFN,CPS55,CPSNUM)=CPSPOS_U_CPSPSB
- ..;NEXT FIND BCMA TOTAL MEDS GIVE ON UD AND MATCH IV ORDERS.
- PRT ;
- S (CNTT,CNTTR)=0
- W !,?5,"Meaningfull Use Stage II Report From " S Y=CPSTART D DD^%DT W Y_" TO " S Y=CPSEND D DD^%DT W Y
- D NOW^%DTC S Y=% D DD^%DT W !,?45,"Run Date/Time:"_Y
- W !,"Order Type",?15,"Total Orders",?30," %100 Tracked"
- W ! F J=1:1:IOM W "-"
- W ! F I="UNIT DOSE","IV" W I,?17,$G(CNT(I)),?35,$G(CNT(I,"TR")),! S CNTT=CNTT+$G(CNT(I)),CNTTR=CNTTR+$G(CNT(I,"TR"))
- W ! F J=1:1:IOM W "-"
- W !,?17,CNTT,?35,CNTTR
- EXIT ;
- Q
- APCMVAEM ; IHS/CMI/LAB - V2 MED BY PROV SUB RTN KFOX ;
- +1 ;;1.0;IHS MU PERFORMANCE REPORTS;**5,6**;MAR 26, 2012;Build 65
- START ;Set beginning/ending sort dates for ORDERS
- +1 SET %DT="AE"
- SET %DT("A")="Enter Start Date range: "
- DO ^%DT
- +2 IF (Y'>0)!(X["^")!(X="")
- DO EXIT
- QUIT
- +3 SET CPSTART=Y
- +4 KILL %DT,%DT("A"),X,Y
- +5 SET Y=CPSTART
- DO DD^%DT
- SET CPSTART(0)=Y
- +6 ;
- +7 SET %DT="AE"
- SET %DT("A")="Enter Ending Date range: "
- DO ^%DT
- +8 IF (Y'>0)!(X["^")!(X="")
- DO EXIT
- QUIT
- +9 SET CPSEND=Y
- +10 KILL %DT,%DT("A"),X,Y
- +11 SET Y=CPSEND
- DO DD^%DT
- SET OEND(0)=Y
- +12 SET (CNT("UNIT DOSE","TR"),CNT("UNIT DOSE"))=0
- +13 KILL ^TMP($JOB)
- P55 ; LOOP 55 UNIT DOSE
- +1 SET CPSDATE=CPSTART
- FOR
- SET CPSDATE=$ORDER(^PS(55,"AUDS",CPSDATE))
- IF CPSDATE>CPSEND!('+CPSDATE)
- QUIT
- Begin DoDot:1
- +2 SET CPSDFN=0
- FOR
- SET CPSDFN=$ORDER(^PS(55,"AUDS",CPSDATE,CPSDFN))
- IF '+CPSDFN
- QUIT
- Begin DoDot:2
- +3 SET CPS55=0
- FOR
- SET CPS55=$ORDER(^PS(55,"AUDS",CPSDATE,CPSDFN,CPS55))
- IF '+CPS55
- QUIT
- Begin DoDot:3
- +4 ;COUNT POSSIBLE DOSES DUE FOR ORDER.
- +5 SET CPSPOS=0
- +6 SET CPSFRE=$PIECE($GET(^PS(55,CPSDFN,5,+CPS55,2)),U,6)
- SET CPSTOP=$PIECE($GET(^PS(55,CPSDFN,5,+CPS55,2)),U,4)
- SET CPSSCH=$PIECE($GET(^PS(55,CPSDFN,5,+CPS55,0)),U,7)
- +7 IF CPSTOP<CPSDATE
- QUIT
- +8 IF CPSFRE="D"&(CPSSCH="C")
- SET CPSN=$LENGTH($PIECE($GET(^PS(55,CPSDFN,5,+CPS55,2)),U,1),"-")
- SET X2=CPSDATE
- SET X1=$SELECT(CPSTOP<DT:DT,1:CPSTOP)
- DO ^%DTC
- SET CPSPOS=CPSN*X
- +9 IF +CPSFRE&(CPSSCH="C")
- Begin DoDot:4
- +10 ;MINS FOR FIRST DATE
- SET CPSS1=0
- SET CPSS1=(24-$EXTRACT($PIECE(CPSDATE,".",2),1,2))*60
- +11 ; MINS FOR MIDNIGHT LAST DATE
- IF CPSTOP>DT
- DO NOW^%DTC
- SET CPSS1=CPSS1+($EXTRACT($PIECE(%,".",2),1,2)*60)
- +12 ;MINS FOR MIDNIGHT LAST DATE
- IF CPSTOP<DT
- SET CPSS1=CPSS1+($EXTRACT($PIECE(CPSTOP,".",2),1,2)*60)
- +13 SET X1=CPSDATE
- SET X2=+1
- DO C^%DTC
- SET X2=X
- SET X1=$SELECT(CPSTOP>DT:DT,1:CPSTOP)
- DO ^%DTC
- SET CPSPOS=((X*1440)+CPSS1)/CPSFRE
- +14 ;S X1=DT,X2=+1 D C^%DTC S CPSNDT=X S X2=CPSDATE,X1=$S(CPSTOP>DT:CPSNDT,1:CPSTOP) D ^%DTC S CPSPOS=((X*1440)+CPSS1)/CPSFRE
- End DoDot:4
- +15 IF CPSSCH="C"!(CPSSCH="P")
- SET CNT("UNIT DOSE")=CNT("UNIT DOSE")+1
- +16 ;LOOK 53.79 FOR DOSE TRACKED.
- +17 ;PRNS TO ONE
- IF CPSSCH="P"
- SET CPSPOS=1
- +18 IF +CPSPOS<0!(CPSPOS=0)
- QUIT
- +19 SET CPSQ=$SELECT(CPSSCH="P":1,CPSSCH="C":1,1:0)
- +20 IF CPSQ=0
- QUIT
- +21 ;W !,CPSSCH
- +22 SET (CPSPSB,CPSN1)=0
- FOR
- SET CPSN1=$ORDER(^PSB(53.79,"AORDX",CPSDFN,CPS55_"U",CPSN1))
- IF '+CPSN1
- QUIT
- SET CPSPSB=CPSPSB+1
- +23 IF CPSPSB<CPSPOS
- QUIT
- +24 SET CNT("UNIT DOSE","TR")=CNT("UNIT DOSE","TR")+1
- SET ^TMP($JOB,"BCMA","TRUD",CPSDFN,CPS55)=CPSPOS_U_CPSPSB
- +25 ;W !,CPS55,U,CPSPOS,U,CPSPSB,U,CPSSCH
- End DoDot:3
- End DoDot:2
- End DoDot:1
- IV ;LOOP IVS
- +1 SET (CNT("IV","TR"),CNT("IV"))=0
- +2 SET CPSDATE=CPSTART
- FOR
- SET CPSDATE=$ORDER(^PS(55,"AIVS",CPSDATE))
- IF CPSDATE>CPSEND!('+CPSDATE)
- QUIT
- Begin DoDot:1
- +3 SET CPSDFN=0
- FOR
- SET CPSDFN=$ORDER(^PS(55,"AIVS",CPSDATE,CPSDFN))
- IF '+CPSDFN
- QUIT
- Begin DoDot:2
- +4 SET CPS55=0
- FOR
- SET CPS55=$ORDER(^PS(55,"AIVS",CPSDATE,CPSDFN,CPS55))
- IF '+CPS55
- QUIT
- Begin DoDot:3
- +5 SET CNT("IV")=CNT("IV")+1
- SET (CPSPSB,CPSPOS)=0
- +6 SET CPSTYPE=$PIECE($GET(^PS(55,CPSDFN,"IV",CPS55,0)),U,4)
- +7 IF CPSTYPE="P"!(CPSTYPE="S")
- Begin DoDot:4
- +8 SET CPSFRE=$PIECE($GET(^PS(55,CPSDFN,"IV",CPS55,0)),U,15)
- IF +CPSFRE
- SET CPSTOP=$PIECE($GET(^PS(55,CPSDFN,"IV",CPS55,0)),U,3)
- SET X2=CPSDATE
- SET X1=$SELECT(CPSTOP<DT:DT,1:CPSTOP)
- DO ^%DTC
- SET CPSPOS=(X*1440)/CPSFRE
- +9 ;ONCE
- IF CPSFRE="O"
- SET CPSPOS=1
- End DoDot:4
- +10 ;COUND TOTAL NUMBER OF IV BAGS FOR ORDER
- +11 IF $DATA(^PS(55,CPSDFN,"IV",+CPS55,"BCMA"))&(CPSTYPE'="P")&(CPSTYPE'="S")
- SET (CPSPOS,CPSNUM)=0
- FOR
- SET CPSNUM=$ORDER(^PS(55,CPSDFN,"IV",+CPS55,"BCMA",CPSNUM))
- IF '+CPSNUM
- QUIT
- SET CPSPOS=CPSPOS+1
- +12 ;NO LABELS
- +13 IF '$DATA(^PS(55,CPSDFN,"IV",+CPS55,"BCMA"))&(CPSTYPE'="P")&(CPSTYPE'="S")
- Begin DoDot:4
- +14 SET CPSVOL=$PIECE($GET(^PS(55,CPSDFN,"IV",CPS55,"SOL",1,0)),U,2)
- SET CPSRAT=$PIECE($GET(^PS(55,CPSDFN,"IV",CPS55,0)),U,8)
- +15 SET CPSTOP=$PIECE($GET(^PS(55,CPSDFN,"IV",CPS55,0)),U,3)
- +16 ;MINS FOR FIRST DATE
- SET CPSS1=0
- SET CPSS1=(24-$EXTRACT($PIECE(CPSDATE,".",2),1,2))*60
- +17 ; MINS FOR MIDNIGHT LAST DATE
- IF CPSTOP>DT
- DO NOW^%DTC
- SET CPSS1=CPSS1+($EXTRACT($PIECE(%,".",2),1,2)*60)
- +18 ;MINS FOR MIDNIGHT LAST DATE
- IF CPSTOP<DT
- SET CPSS1=CPSS1+($EXTRACT($PIECE(CPSTOP,".",2),1,2)*60)
- +19 SET X1=CPSDATE
- SET X2=+1
- DO C^%DTC
- SET X2=X
- SET X1=$SELECT(CPSTOP>DT:DT,1:CPSTOP)
- DO ^%DTC
- SET CPSPOS=(((((+CPSRAT*24)*X)+CPSS1)+CPSS1)\+CPSVOL)
- End DoDot:4
- +20 ;NO POSSIBLE FOUND AND NO INFUSTION RATE BAIL THIS ONE.
- IF '+CPSPOS&('+$GET(CPSRAT))
- QUIT
- +21 ;LOOK IN BCMA FOR IVS
- +22 SET (CPSNUM,CPSPSB)=0
- FOR
- SET CPSNUM=$ORDER(^PSB(53.79,"AUID",CPSDFN,CPS55_"V",CPSNUM))
- IF '+CPSNUM
- QUIT
- SET CPSPSB=CPSPSB+1
- Begin DoDot:4
- +23 ;W !,CPS55,U,CPSPOS,U,CPSPSB
- +24 IF CPSPSB<CPSPOS
- QUIT
- +25 SET CNT("IV","TR")=CNT("IV","TR")+1
- SET ^TMP($JOB,"BCMA","IV",CPSDFN,CPS55,CPSNUM)=CPSPOS_U_CPSPSB
- End DoDot:4
- End DoDot:3
- +26 ;NEXT FIND BCMA TOTAL MEDS GIVE ON UD AND MATCH IV ORDERS.
- End DoDot:2
- End DoDot:1
- PRT ;
- +1 SET (CNTT,CNTTR)=0
- +2 WRITE !,?5,"Meaningfull Use Stage II Report From "
- SET Y=CPSTART
- DO DD^%DT
- WRITE Y_" TO "
- SET Y=CPSEND
- DO DD^%DT
- WRITE Y
- +3 DO NOW^%DTC
- SET Y=%
- DO DD^%DT
- WRITE !,?45,"Run Date/Time:"_Y
- +4 WRITE !,"Order Type",?15,"Total Orders",?30," %100 Tracked"
- +5 WRITE !
- FOR J=1:1:IOM
- WRITE "-"
- +6 WRITE !
- FOR I="UNIT DOSE","IV"
- WRITE I,?17,$GET(CNT(I)),?35,$GET(CNT(I,"TR")),!
- SET CNTT=CNTT+$GET(CNT(I))
- SET CNTTR=CNTTR+$GET(CNT(I,"TR"))
- +7 WRITE !
- FOR J=1:1:IOM
- WRITE "-"
- +8 WRITE !,?17,CNTT,?35,CNTTR
- EXIT ;
- +1 QUIT
