- PSDAMIS1 ;BIR/JPW-Print NAOU AMIS Report by Drug ; 1 Sept 94
- ;;3.0; CONTROLLED SUBSTANCES ;**17**;13 Feb 97
- ;
- ;References to ^PSD(58.8, are covered by DBIA 2711
- ;References to ^PSD(58.81 are covered by DBIS 2808
- ;References to ^PSDRUG( are covered by DBIA 221
- START ;entry point for report
- K ^TMP("PSDAMIS",$J),^TMP("PSDAMISS",$J),^TMP("PSDAMIST",$J),^TMP("PSDAMISG",$J),^TMP("PSDAMISQT",$J),^TMP("PSDAMISQ",$J),^TMP("PSDAMISC",$J),^TMP("PSDAMISCN",$J),^TMP("PSDAMISCG",$J)
- K ^TMP("PSDM",$J),^TMP("PSDAMISVG",$J),^TMP("PSDAMISCVG",$J)
- I $D(ALL) D ALL G CHK
- F PSDR=0:0 S PSDR=$O(LOC(PSDR)) Q:'PSDR F JJ=PSDSD:0 S JJ=$O(^PSD(58.81,"ACT",JJ)) Q:'JJ!(JJ>PSDED) F JJ1=0:0 S JJ1=$O(^PSD(58.81,"ACT",JJ,JJ1)) Q:'JJ1 F KK=0:0 S KK=$O(^PSD(58.81,"ACT",JJ,JJ1,PSDR,2,KK)) Q:'KK D SET
- CHK ;checks for zero cost data & sends e-mail from ^PSDCOSM
- I $D(^TMP("PSDM",$J)) S PSDCHO(1)="AMIS Report by DRUG",Y=PSDT X ^DD("DD") S PSDT(1)=Y D ^PSDCOSM K PSDCHO,^TMP("PSDM",$J)
- G ^PSDAMIS0
- ALL ;loops for all drugs
- Q:'$D(ALL)
- F JJ=PSDSD:0 S JJ=$O(^PSD(58.81,"ACT",JJ)) Q:'JJ!(JJ>PSDED) F JJ1=0:0 S JJ1=$O(^PSD(58.81,"ACT",JJ,JJ1)) Q:'JJ1 F PSDR=0:0 S PSDR=$O(^PSD(58.81,"ACT",JJ,JJ1,PSDR)) Q:'PSDR D
- .F KK=0:0 S KK=$O(^PSD(58.81,"ACT",JJ,JJ1,PSDR,2,KK)) Q:'KK D SET
- Q
- SET ;sets data
- Q:'$D(^PSD(58.81,KK,0)) S NODE=^PSD(58.81,KK,0),PSD=+$P(NODE,"^",18),PSDS=+$P(NODE,"^",3)
- Q:$P($G(^PSD(58.8,PSD,0)),"^",3)'=+PSDSITE Q:$D(^PSD(58.81,KK,5))
- S PSDRN=$S($P($G(^PSDRUG(+PSDR,0)),"^")]"":$P(^(0),"^"),1:"DRUG NAME MISSING")
- S NAOUN=$S($P($G(^PSD(58.8,PSD,0)),"^")]"":$P(^(0),"^"),1:"NAOU NAME MISSING")
- S PSDSN=$S($P($G(^PSD(58.8,PSDS,0)),"^")]"":$P(^(0),"^"),1:"DISP. SITE NAME MISSING")
- S PSDPN=$S($P(NODE,"^",17)]"":$P(NODE,"^",17),1:"DISP W/O GS"),QTY=+$P(NODE,"^",6)
- S:+$P($G(^PSD(58.81,KK,4)),"^",3) QTY=+$P(^(4),"^",3)
- S COST=+$P($G(^PSDRUG(PSDR,660)),"^",6),COST=COST*QTY
- ;
- ;DAVE B (PSD*3*17 29APR99) - More detail on zero cost
- I 'COST S Y=$P(NODE,"^",4) X ^DD("DD") S ^TMP("PSDM",$J,PSDRN,Y)=$P(NODE,"^",1)_"^"_+$P($G(^PSDRUG(PSDR,660)),"^",6)_"^"_QTY W !,"SETTING GLBL"
- S ^TMP("PSDAMIS",$J,PSDRN,NAOUN,PSDPN,JJ)=QTY_"^"_COST
- S:'$D(^TMP("PSDAMIST",$J,PSDRN)) ^TMP("PSDAMIST",$J,PSDRN)=0 S ^TMP("PSDAMIST",$J,PSDRN)=+^TMP("PSDAMIST",$J,PSDRN)+1
- S:'$D(^TMP("PSDAMISQT",$J,PSDRN)) ^TMP("PSDAMISQT",$J,PSDRN)=0 S ^TMP("PSDAMISQT",$J,PSDRN)=+^TMP("PSDAMISQT",$J,PSDRN)+QTY
- S:'$D(^TMP("PSDAMISS",$J,PSDRN,NAOUN)) ^TMP("PSDAMISS",$J,PSDRN,NAOUN)=0 S ^TMP("PSDAMISS",$J,PSDRN,NAOUN)=+^TMP("PSDAMISS",$J,PSDRN,NAOUN)+1
- S:'$D(^TMP("PSDAMISQ",$J,PSDRN,NAOUN)) ^TMP("PSDAMISQ",$J,PSDRN,NAOUN)=0 S ^TMP("PSDAMISQ",$J,PSDRN,NAOUN)=+^TMP("PSDAMISQ",$J,PSDRN,NAOUN)+QTY
- S:'$D(^TMP("PSDAMISG",$J)) ^TMP("PSDAMISG",$J)=0 S ^TMP("PSDAMISG",$J)=+^TMP("PSDAMISG",$J)+1
- S:'$D(^TMP("PSDAMISVG",$J,PSDSN)) ^TMP("PSDAMISVG",$J,PSDSN)=0 S ^TMP("PSDAMISVG",$J,PSDSN)=+^TMP("PSDAMISVG",$J,PSDSN)+1
- S:'$D(^TMP("PSDAMISC",$J,PSDRN,NAOUN)) ^TMP("PSDAMISC",$J,PSDRN,NAOUN)=0 S ^TMP("PSDAMISC",$J,PSDRN,NAOUN)=+^TMP("PSDAMISC",$J,PSDRN,NAOUN)+COST
- S:'$D(^TMP("PSDAMISCN",$J,PSDRN)) ^TMP("PSDAMISCN",$J,PSDRN)=0 S ^TMP("PSDAMISCN",$J,PSDRN)=+^TMP("PSDAMISCN",$J,PSDRN)+COST
- S:'$D(^TMP("PSDAMISCG",$J)) ^TMP("PSDAMISCG",$J)=0 S ^TMP("PSDAMISCG",$J)=+^TMP("PSDAMISCG",$J)+COST
- S:'$D(^TMP("PSDAMISCVG",$J,PSDSN)) ^TMP("PSDAMISCVG",$J,PSDSN)=0 S ^TMP("PSDAMISCVG",$J,PSDSN)=+^TMP("PSDAMISCVG",$J,PSDSN)+COST
- Q
- PSDAMIS1 ;BIR/JPW-Print NAOU AMIS Report by Drug ; 1 Sept 94
- +1 ;;3.0; CONTROLLED SUBSTANCES ;**17**;13 Feb 97
- +2 ;
- +3 ;References to ^PSD(58.8, are covered by DBIA 2711
- +4 ;References to ^PSD(58.81 are covered by DBIS 2808
- +5 ;References to ^PSDRUG( are covered by DBIA 221
- START ;entry point for report
- +1 KILL ^TMP("PSDAMIS",$JOB),^TMP("PSDAMISS",$JOB),^TMP("PSDAMIST",$JOB),^TMP("PSDAMISG",$JOB),^TMP("PSDAMISQT",$JOB),^TMP("PSDAMISQ",$JOB),^TMP("PSDAMISC",$JOB),^TMP("PSDAMISCN",$JOB),^TMP("PSDAMISCG",$JOB)
- +2 KILL ^TMP("PSDM",$JOB),^TMP("PSDAMISVG",$JOB),^TMP("PSDAMISCVG",$JOB)
- +3 IF $DATA(ALL)
- DO ALL
- GOTO CHK
- +4 FOR PSDR=0:0
- SET PSDR=$ORDER(LOC(PSDR))
- IF 'PSDR
- QUIT
- FOR JJ=PSDSD:0
- SET JJ=$ORDER(^PSD(58.81,"ACT",JJ))
- IF 'JJ!(JJ>PSDED)
- QUIT
- FOR JJ1=0:0
- SET JJ1=$ORDER(^PSD(58.81,"ACT",JJ,JJ1))
- IF 'JJ1
- QUIT
- FOR KK=0:0
- SET KK=$ORDER(^PSD(58.81,"ACT",JJ,JJ1,PSDR,2,KK))
- IF 'KK
- QUIT
- DO SET
- CHK ;checks for zero cost data & sends e-mail from ^PSDCOSM
- +1 IF $DATA(^TMP("PSDM",$JOB))
- SET PSDCHO(1)="AMIS Report by DRUG"
- SET Y=PSDT
- XECUTE ^DD("DD")
- SET PSDT(1)=Y
- DO ^PSDCOSM
- KILL PSDCHO,^TMP("PSDM",$JOB)
- +2 GOTO ^PSDAMIS0
- ALL ;loops for all drugs
- +1 IF '$DATA(ALL)
- QUIT
- +2 FOR JJ=PSDSD:0
- SET JJ=$ORDER(^PSD(58.81,"ACT",JJ))
- IF 'JJ!(JJ>PSDED)
- QUIT
- FOR JJ1=0:0
- SET JJ1=$ORDER(^PSD(58.81,"ACT",JJ,JJ1))
- IF 'JJ1
- QUIT
- FOR PSDR=0:0
- SET PSDR=$ORDER(^PSD(58.81,"ACT",JJ,JJ1,PSDR))
- IF 'PSDR
- QUIT
- Begin DoDot:1
- +3 FOR KK=0:0
- SET KK=$ORDER(^PSD(58.81,"ACT",JJ,JJ1,PSDR,2,KK))
- IF 'KK
- QUIT
- DO SET
- End DoDot:1
- +4 QUIT
- SET ;sets data
- +1 IF '$DATA(^PSD(58.81,KK,0))
- QUIT
- SET NODE=^PSD(58.81,KK,0)
- SET PSD=+$PIECE(NODE,"^",18)
- SET PSDS=+$PIECE(NODE,"^",3)
- +2 IF $PIECE($GET(^PSD(58.8,PSD,0)),"^",3)'=+PSDSITE
- QUIT
- IF $DATA(^PSD(58.81,KK,5))
- QUIT
- +3 SET PSDRN=$SELECT($PIECE($GET(^PSDRUG(+PSDR,0)),"^")]"":$PIECE(^(0),"^"),1:"DRUG NAME MISSING")
- +4 SET NAOUN=$SELECT($PIECE($GET(^PSD(58.8,PSD,0)),"^")]"":$PIECE(^(0),"^"),1:"NAOU NAME MISSING")
- +5 SET PSDSN=$SELECT($PIECE($GET(^PSD(58.8,PSDS,0)),"^")]"":$PIECE(^(0),"^"),1:"DISP. SITE NAME MISSING")
- +6 SET PSDPN=$SELECT($PIECE(NODE,"^",17)]"":$PIECE(NODE,"^",17),1:"DISP W/O GS")
- SET QTY=+$PIECE(NODE,"^",6)
- +7 IF +$PIECE($GET(^PSD(58.81,KK,4)),"^",3)
- SET QTY=+$PIECE(^(4),"^",3)
- +8 SET COST=+$PIECE($GET(^PSDRUG(PSDR,660)),"^",6)
- SET COST=COST*QTY
- +9 ;
- +10 ;DAVE B (PSD*3*17 29APR99) - More detail on zero cost
- +11 IF 'COST
- SET Y=$PIECE(NODE,"^",4)
- XECUTE ^DD("DD")
- SET ^TMP("PSDM",$JOB,PSDRN,Y)=$PIECE(NODE,"^",1)_"^"_+$PIECE($GET(^PSDRUG(PSDR,660)),"^",6)_"^"_QTY
- WRITE !,"SETTING GLBL"
- +12 SET ^TMP("PSDAMIS",$JOB,PSDRN,NAOUN,PSDPN,JJ)=QTY_"^"_COST
- +13 IF '$DATA(^TMP("PSDAMIST",$JOB,PSDRN))
- SET ^TMP("PSDAMIST",$JOB,PSDRN)=0
- SET ^TMP("PSDAMIST",$JOB,PSDRN)=+^TMP("PSDAMIST",$JOB,PSDRN)+1
- +14 IF '$DATA(^TMP("PSDAMISQT",$JOB,PSDRN))
- SET ^TMP("PSDAMISQT",$JOB,PSDRN)=0
- SET ^TMP("PSDAMISQT",$JOB,PSDRN)=+^TMP("PSDAMISQT",$JOB,PSDRN)+QTY
- +15 IF '$DATA(^TMP("PSDAMISS",$JOB,PSDRN,NAOUN))
- SET ^TMP("PSDAMISS",$JOB,PSDRN,NAOUN)=0
- SET ^TMP("PSDAMISS",$JOB,PSDRN,NAOUN)=+^TMP("PSDAMISS",$JOB,PSDRN,NAOUN)+1
- +16 IF '$DATA(^TMP("PSDAMISQ",$JOB,PSDRN,NAOUN))
- SET ^TMP("PSDAMISQ",$JOB,PSDRN,NAOUN)=0
- SET ^TMP("PSDAMISQ",$JOB,PSDRN,NAOUN)=+^TMP("PSDAMISQ",$JOB,PSDRN,NAOUN)+QTY
- +17 IF '$DATA(^TMP("PSDAMISG",$JOB))
- SET ^TMP("PSDAMISG",$JOB)=0
- SET ^TMP("PSDAMISG",$JOB)=+^TMP("PSDAMISG",$JOB)+1
- +18 IF '$DATA(^TMP("PSDAMISVG",$JOB,PSDSN))
- SET ^TMP("PSDAMISVG",$JOB,PSDSN)=0
- SET ^TMP("PSDAMISVG",$JOB,PSDSN)=+^TMP("PSDAMISVG",$JOB,PSDSN)+1
- +19 IF '$DATA(^TMP("PSDAMISC",$JOB,PSDRN,NAOUN))
- SET ^TMP("PSDAMISC",$JOB,PSDRN,NAOUN)=0
- SET ^TMP("PSDAMISC",$JOB,PSDRN,NAOUN)=+^TMP("PSDAMISC",$JOB,PSDRN,NAOUN)+COST
- +20 IF '$DATA(^TMP("PSDAMISCN",$JOB,PSDRN))
- SET ^TMP("PSDAMISCN",$JOB,PSDRN)=0
- SET ^TMP("PSDAMISCN",$JOB,PSDRN)=+^TMP("PSDAMISCN",$JOB,PSDRN)+COST
- +21 IF '$DATA(^TMP("PSDAMISCG",$JOB))
- SET ^TMP("PSDAMISCG",$JOB)=0
- SET ^TMP("PSDAMISCG",$JOB)=+^TMP("PSDAMISCG",$JOB)+COST
- +22 IF '$DATA(^TMP("PSDAMISCVG",$JOB,PSDSN))
- SET ^TMP("PSDAMISCVG",$JOB,PSDSN)=0
- SET ^TMP("PSDAMISCVG",$JOB,PSDSN)=+^TMP("PSDAMISCVG",$JOB,PSDSN)+COST
- +23 QUIT
