PSALOG1H ;BIR/LTL,JMB-Unposted Procurement History - CONT'D ;7/23/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
;This routine prints the pharmacy procurement history High Cost Items
;report for a selected month. It is called by PSALOG.
;
HIGH S PSAPG=0 D HDR
;If the "PSA" array does not exist, the "PSAC" array cannot be created.
I '$D(^TMP("PSA",$J)) W !!,"No items were found for the selected month." G END^PSALOG0
;If the "PSA" array exists, the "PSAC" does not exit, and the user
;requested the Item Totals report, the routine attempted to create
;the "PSAC" array and found no data.
I $D(^TMP("PSA",$J)),'$D(^TMP("PSAC",$J)),$G(PSATOTAL) W !!,"No items were found for the selected month." G END^PSALOG0
;If the "PSA" array exists, the "PSAC" does not exit, and the user
;did not request the Item Totals report, create the "PSAC" array.
I $D(^TMP("PSA",$J)),'$D(^TMP("PSAC",$J)),'$G(PSATOTAL) D CREATE
I '$D(^TMP("PSAC",$J)) W !!,"No items were found for the selected month." G END^PSALOG0
S PSAINVO=0 F S PSAINVO=+$O(^TMP("PSAC",$J,PSAINVO)) Q:'PSAINVO!(PSAOUT) D
.D:$Y+4>IOSL HDR Q:PSAOUT
.S PSAITEM="" F S PSAITEM=$O(^TMP("PSAC",$J,PSAINVO,PSAITEM)) Q:PSAITEM="" D
..Q:$G(^TMP("PSAC",$J,PSAINVO,PSAITEM))<PSALOW
..W !,$E(PSAITEM,1,56)
..S X=$P($G(^TMP("PSAC",$J,PSAINVO,PSAITEM)),"^"),X2="2$" D COMMA^%DTC
..W ?58,X,"(",$P($G(^TMP("PSAC",$J,PSAINVO,PSAITEM)),"^",2),")",!
G END^PSALOG0
HDR I $E(IOST,1,2)="C-",PSAPG D Q:PSAOUT
.S PSASS=22-$Y F PSAKK=1:1:PSASS W !
.S DIR(0)="E" D ^DIR K DIR S:'Y PSAOUT=1
I $$S^%ZTLOAD W !!,"Task #",$G(ZTSK),", ",$G(ZTDESC)," was stopped by ",$P($G(^VA(200,+$G(DUZ),0)),"^"),"." S PSAOUT=1 Q
W:$Y @IOF S PSAPG=PSAPG+1
W:$E(IOST)'="C" !!,PSARPDT W:$E(IOST,1,2)="C-" !
W ?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",?72,"PAGE ",$J(PSAPG,2)
W !?((80-(65+$L(PSALOW)))/2),"UNPOSTED PHARMACY PROCUREMENTS FOR "_PSAMOYR_" HIGH COST ITEMS OVER $",PSALOW
W !!?1,"ITEM NAME",?61,"TOTAL ITEM COST",!,PSADLN
Q
CREATE ;Create the "PSAC" array.
S PSACP=0 F S PSACP=$O(^TMP("PSA",$J,PSACP)) Q:'PSACP D
.S PSAITEM="" F S PSAITEM=$O(^TMP("PSA",$J,PSACP,PSAITEM)) Q:PSAITEM']"" S PSAIEN=0 F S PSAIEN=$O(^TMP("PSA",$J,PSACP,PSAITEM,PSAIEN)) Q:'PSAIEN D
..S PSATMP=$G(^TMP("PSA",$J,PSACP,PSAITEM,PSAIEN))
..S PSATOTO=$G(PSATOTO)+($P(PSATMP,"^",2)*$P(PSATMP,"^",9))
..I '$O(^TMP("PSA",$J,PSACP,PSAITEM,PSAIEN)) S ^TMP("PSAC",$J,(999999999-PSATOTO),PSAITEM)=PSATOTO_"^"_PSACP K PSATOTO
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSALOG1H 2513 printed Sep 23, 2025@19:25:41 Page 2
PSALOG1H ;BIR/LTL,JMB-Unposted Procurement History - CONT'D ;7/23/97
+1 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
+2 ;This routine prints the pharmacy procurement history High Cost Items
+3 ;report for a selected month. It is called by PSALOG.
+4 ;
HIGH SET PSAPG=0
DO HDR
+1 ;If the "PSA" array does not exist, the "PSAC" array cannot be created.
+2 IF '$DATA(^TMP("PSA",$JOB))
WRITE !!,"No items were found for the selected month."
GOTO END^PSALOG0
+3 ;If the "PSA" array exists, the "PSAC" does not exit, and the user
+4 ;requested the Item Totals report, the routine attempted to create
+5 ;the "PSAC" array and found no data.
+6 IF $DATA(^TMP("PSA",$JOB))
IF '$DATA(^TMP("PSAC",$JOB))
IF $GET(PSATOTAL)
WRITE !!,"No items were found for the selected month."
GOTO END^PSALOG0
+7 ;If the "PSA" array exists, the "PSAC" does not exit, and the user
+8 ;did not request the Item Totals report, create the "PSAC" array.
+9 IF $DATA(^TMP("PSA",$JOB))
IF '$DATA(^TMP("PSAC",$JOB))
IF '$GET(PSATOTAL)
DO CREATE
+10 IF '$DATA(^TMP("PSAC",$JOB))
WRITE !!,"No items were found for the selected month."
GOTO END^PSALOG0
+11 SET PSAINVO=0
FOR
SET PSAINVO=+$ORDER(^TMP("PSAC",$JOB,PSAINVO))
if 'PSAINVO!(PSAOUT)
QUIT
Begin DoDot:1
+12 if $Y+4>IOSL
DO HDR
if PSAOUT
QUIT
+13 SET PSAITEM=""
FOR
SET PSAITEM=$ORDER(^TMP("PSAC",$JOB,PSAINVO,PSAITEM))
if PSAITEM=""
QUIT
Begin DoDot:2
+14 if $GET(^TMP("PSAC",$JOB,PSAINVO,PSAITEM))<PSALOW
QUIT
+15 WRITE !,$EXTRACT(PSAITEM,1,56)
+16 SET X=$PIECE($GET(^TMP("PSAC",$JOB,PSAINVO,PSAITEM)),"^")
SET X2="2$"
DO COMMA^%DTC
+17 WRITE ?58,X,"(",$PIECE($GET(^TMP("PSAC",$JOB,PSAINVO,PSAITEM)),"^",2),")",!
End DoDot:2
End DoDot:1
+18 GOTO END^PSALOG0
HDR IF $EXTRACT(IOST,1,2)="C-"
IF PSAPG
Begin DoDot:1
+1 SET PSASS=22-$Y
FOR PSAKK=1:1:PSASS
WRITE !
+2 SET DIR(0)="E"
DO ^DIR
KILL DIR
if 'Y
SET PSAOUT=1
End DoDot:1
if PSAOUT
QUIT
+3 IF $$S^%ZTLOAD
WRITE !!,"Task #",$GET(ZTSK),", ",$GET(ZTDESC)," was stopped by ",$PIECE($GET(^VA(200,+$GET(DUZ),0)),"^"),"."
SET PSAOUT=1
QUIT
+4 if $Y
WRITE @IOF
SET PSAPG=PSAPG+1
+5 if $EXTRACT(IOST)'="C"
WRITE !!,PSARPDT
if $EXTRACT(IOST,1,2)="C-"
WRITE !
+6 WRITE ?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",?72,"PAGE ",$JUSTIFY(PSAPG,2)
+7 WRITE !?((80-(65+$LENGTH(PSALOW)))/2),"UNPOSTED PHARMACY PROCUREMENTS FOR "_PSAMOYR_" HIGH COST ITEMS OVER $",PSALOW
+8 WRITE !!?1,"ITEM NAME",?61,"TOTAL ITEM COST",!,PSADLN
+9 QUIT
CREATE ;Create the "PSAC" array.
+1 SET PSACP=0
FOR
SET PSACP=$ORDER(^TMP("PSA",$JOB,PSACP))
if 'PSACP
QUIT
Begin DoDot:1
+2 SET PSAITEM=""
FOR
SET PSAITEM=$ORDER(^TMP("PSA",$JOB,PSACP,PSAITEM))
if PSAITEM']""
QUIT
SET PSAIEN=0
FOR
SET PSAIEN=$ORDER(^TMP("PSA",$JOB,PSACP,PSAITEM,PSAIEN))
if 'PSAIEN
QUIT
Begin DoDot:2
+3 SET PSATMP=$GET(^TMP("PSA",$JOB,PSACP,PSAITEM,PSAIEN))
+4 SET PSATOTO=$GET(PSATOTO)+($PIECE(PSATMP,"^",2)*$PIECE(PSATMP,"^",9))
+5 IF '$ORDER(^TMP("PSA",$JOB,PSACP,PSAITEM,PSAIEN))
SET ^TMP("PSAC",$JOB,(999999999-PSATOTO),PSAITEM)=PSATOTO_"^"_PSACP
KILL PSATOTO
End DoDot:2
End DoDot:1
+6 QUIT
