PSDAMIS2 ;BIR/JPW-Print NAOU AMIS Report by NAOU ; 1 Sept 94
;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
START ;entry point for report
K ^TMP("PSDAMIS",$J),^TMP("PSDAMISS",$J),^TMP("PSDAMIST",$J),^TMP("PSDAMISG",$J),^TMP("PSDAMISQ",$J),^TMP("PSDAMISC",$J),^TMP("PSDAMISCG",$J),^TMP("PSDAMISCN",$J)
K ^TMP("PSDM",$J),^TMP("PSDAMISCVG",$J),^TMP("PSDAMISVG",$J)
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
CHK ;checks for zero cost data & sends e-mail from ^PSDCOSM
I $D(^TMP("PSDM",$J)) S PSDCHO(1)="AMIS Report by NAOU",Y=PSDT X ^DD("DD") S PSDT(1)=Y D ^PSDCOSM K PSDCHO,^TMP("PSDM",$J)
G ^PSDAMIS3
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:'$D(LOC(PSD)) 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
S:'COST ^TMP("PSDM",$J,PSDRN)=""
S ^TMP("PSDAMIS",$J,NAOUN,PSDRN,PSDPN,JJ)=QTY_"^"_COST
S:'$D(^TMP("PSDAMIST",$J,NAOUN)) ^TMP("PSDAMIST",$J,NAOUN)=0 S ^TMP("PSDAMIST",$J,NAOUN)=+^TMP("PSDAMIST",$J,NAOUN)+1
S:'$D(^TMP("PSDAMISS",$J,NAOUN,PSDRN)) ^TMP("PSDAMISS",$J,NAOUN,PSDRN)=0 S ^TMP("PSDAMISS",$J,NAOUN,PSDRN)=+^TMP("PSDAMISS",$J,NAOUN,PSDRN)+1
S:'$D(^TMP("PSDAMISQ",$J,NAOUN,PSDRN)) ^TMP("PSDAMISQ",$J,NAOUN,PSDRN)=0 S ^TMP("PSDAMISQ",$J,NAOUN,PSDRN)=+^TMP("PSDAMISQ",$J,NAOUN,PSDRN)+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,NAOUN,PSDRN)) ^TMP("PSDAMISC",$J,NAOUN,PSDRN)=0 S ^TMP("PSDAMISC",$J,NAOUN,PSDRN)=+^TMP("PSDAMISC",$J,NAOUN,PSDRN)+COST
S:'$D(^TMP("PSDAMISCN",$J,NAOUN)) ^TMP("PSDAMISCN",$J,NAOUN)=0 S ^TMP("PSDAMISCN",$J,NAOUN)=+^TMP("PSDAMISCN",$J,NAOUN)+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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDAMIS2 2643 printed Apr 09, 2024@20:54:19 Page 2
PSDAMIS2 ;BIR/JPW-Print NAOU AMIS Report by NAOU ; 1 Sept 94
+1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
START ;entry point for report
+1 KILL ^TMP("PSDAMIS",$JOB),^TMP("PSDAMISS",$JOB),^TMP("PSDAMIST",$JOB),^TMP("PSDAMISG",$JOB),^TMP("PSDAMISQ",$JOB),^TMP("PSDAMISC",$JOB),^TMP("PSDAMISCG",$JOB),^TMP("PSDAMISCN",$JOB)
+2 KILL ^TMP("PSDM",$JOB),^TMP("PSDAMISCVG",$JOB),^TMP("PSDAMISVG",$JOB)
+3 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
+4 FOR KK=0:0
SET KK=$ORDER(^PSD(58.81,"ACT",JJ,JJ1,PSDR,2,KK))
if 'KK
QUIT
DO SET
End DoDot:1
CHK ;checks for zero cost data & sends e-mail from ^PSDCOSM
+1 IF $DATA(^TMP("PSDM",$JOB))
SET PSDCHO(1)="AMIS Report by NAOU"
SET Y=PSDT
XECUTE ^DD("DD")
SET PSDT(1)=Y
DO ^PSDCOSM
KILL PSDCHO,^TMP("PSDM",$JOB)
+2 GOTO ^PSDAMIS3
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 '$DATA(LOC(PSD))
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 if 'COST
SET ^TMP("PSDM",$JOB,PSDRN)=""
+10 SET ^TMP("PSDAMIS",$JOB,NAOUN,PSDRN,PSDPN,JJ)=QTY_"^"_COST
+11 if '$DATA(^TMP("PSDAMIST",$JOB,NAOUN))
SET ^TMP("PSDAMIST",$JOB,NAOUN)=0
SET ^TMP("PSDAMIST",$JOB,NAOUN)=+^TMP("PSDAMIST",$JOB,NAOUN)+1
+12 if '$DATA(^TMP("PSDAMISS",$JOB,NAOUN,PSDRN))
SET ^TMP("PSDAMISS",$JOB,NAOUN,PSDRN)=0
SET ^TMP("PSDAMISS",$JOB,NAOUN,PSDRN)=+^TMP("PSDAMISS",$JOB,NAOUN,PSDRN)+1
+13 if '$DATA(^TMP("PSDAMISQ",$JOB,NAOUN,PSDRN))
SET ^TMP("PSDAMISQ",$JOB,NAOUN,PSDRN)=0
SET ^TMP("PSDAMISQ",$JOB,NAOUN,PSDRN)=+^TMP("PSDAMISQ",$JOB,NAOUN,PSDRN)+QTY
+14 if '$DATA(^TMP("PSDAMISG",$JOB))
SET ^TMP("PSDAMISG",$JOB)=0
SET ^TMP("PSDAMISG",$JOB)=+^TMP("PSDAMISG",$JOB)+1
+15 if '$DATA(^TMP("PSDAMISVG",$JOB,PSDSN))
SET ^TMP("PSDAMISVG",$JOB,PSDSN)=0
SET ^TMP("PSDAMISVG",$JOB,PSDSN)=+^TMP("PSDAMISVG",$JOB,PSDSN)+1
+16 if '$DATA(^TMP("PSDAMISC",$JOB,NAOUN,PSDRN))
SET ^TMP("PSDAMISC",$JOB,NAOUN,PSDRN)=0
SET ^TMP("PSDAMISC",$JOB,NAOUN,PSDRN)=+^TMP("PSDAMISC",$JOB,NAOUN,PSDRN)+COST
+17 if '$DATA(^TMP("PSDAMISCN",$JOB,NAOUN))
SET ^TMP("PSDAMISCN",$JOB,NAOUN)=0
SET ^TMP("PSDAMISCN",$JOB,NAOUN)=+^TMP("PSDAMISCN",$JOB,NAOUN)+COST
+18 if '$DATA(^TMP("PSDAMISCG",$JOB))
SET ^TMP("PSDAMISCG",$JOB)=0
SET ^TMP("PSDAMISCG",$JOB)=+^TMP("PSDAMISCG",$JOB)+COST
+19 if '$DATA(^TMP("PSDAMISCVG",$JOB,PSDSN))
SET ^TMP("PSDAMISCVG",$JOB,PSDSN)=0
SET ^TMP("PSDAMISCVG",$JOB,PSDSN)=+^TMP("PSDAMISCVG",$JOB,PSDSN)+COST
+20 QUIT
