- 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 Feb 18, 2025@23:16 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