- PSALOG1 ;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 Item Totals report
- ;for a selected month. This routine is called by PSALOG.
- ;
- TOTALS S (PSAPG,PSACP,PSAIEN)=0,PSAITEM="" D HDR
- I '$D(^TMP("PSA",$J)) W !!,"No items were found for the selected month." G END^PSALOG0
- F PSAC=0:1 S PSACP=$O(^TMP("PSA",$J,PSACP)) Q:'PSACP!(PSAOUT) D:PSAC HDR G:PSAOUT END^PSALOG0 W !," << STATION/CP: "_PSACP_" >>" D G:PSAOUT END^PSALOG0
- .F S PSAITEM=$O(^TMP("PSA",$J,PSACP,PSAITEM)) Q:PSAOUT!(PSAITEM']"") D:$Y+6>IOSL HDR Q:PSAOUT F S PSAIEN=$O(^TMP("PSA",$J,PSACP,PSAITEM,PSAIEN)) Q:PSAOUT!('PSAIEN) D:$Y+4>IOSL HDR Q:PSAOUT D
- ..S PSATMP=$G(^TMP("PSA",$J,PSACP,PSAITEM,PSAIEN))
- ..W:'$G(PSAMORE) !,$E(PSAITEM,1,50),$S($P(PSATMP,"^",5):" ("_$P(PSATMP,"^",5)_")",1:""),?60,"NDC: ",$P(PSATMP,"^",15),!," DRUG file: ",$S($P($G(^PSDRUG(+$O(^PSDRUG("AB",+$P(PSATMP,"^",5),0)),0)),"^")]"":$P($G(^(0)),"^"),1:"Not connected yet")
- ..W !," Vendor: ",$$VENNAME^PRCPUX1($P($G(^PRC(442,+PSAIEN,1)),"^")_"PRC(440")
- ..S PSAUNIT=$$UNITCODE^PRCPUX1($P(PSATMP,"^",3))
- ..I $Y+7>IOSL D HDR Q:PSAOUT
- ..W:'$G(PSAMORE) !!," PO#",?9,"DATE",?21,"QTY",?32,"QTY",?44,"$/",PSAUNIT,?60,"TOTAL",?74,"TOTAL",!?21,"ORD",?31,"REC'D",?60,"ORD",?74,"REC'D"
- ..W !!," "_$E($P($G(^PRC(442,+PSAIEN,0)),"^"),5,10) S PSAFCP=$P($G(^(0)),"^",3)
- ..S Y=$P($G(^PRC(442,+PSAIEN,1)),"^",15) X ^DD("DD") S PSADATE=$S($L(Y)=10:$E(Y,1,5),$L(Y)=11:$E(Y,1,6),1:"UNKNOWN")
- ..S PSAQTYO=$P(PSATMP,"^",2),PSATQTYO=$G(PSATQTYO)+PSAQTYO
- ..W ?9,PSADATE,$J(PSAQTYO,8)_" ",PSAUNIT
- ..S PSAQTYP=$P($G(^PRC(442,+PSAIEN,2,+$O(^PRC(442,+PSAIEN,2,"B",+$P(PSATMP,"^"),0)),2)),"^",8),PSATOTP=$G(PSATOTP)+PSAQTYP W $J(PSAQTYP,8)_" ",PSAUNIT
- ..S X=$P(PSATMP,"^",9),X2="2$",X3=10 D COMMA^%DTC W ?40,X
- ..S X=PSAQTYO*$P(PSATMP,"^",9),PSATOTO=$G(PSATOTO)+X,X2="2$" D COMMA^%DTC W ?56,X
- ..S X=PSAQTYP*$P(PSATMP,"^",9),PSATOTR=$G(PSATOTR)+X,X2="2$" D COMMA^%DTC W ?70,X
- ..W !,PSASLN
- ..I '$O(^TMP("PSA",$J,PSACP,PSAITEM,PSAIEN)),$G(PSAMORE) D Q:PSAOUT
- ...I $Y+4>IOSL D HDR Q:PSAOUT
- ...W !?6,"TOTALS=>",$J(PSATQTYO,8),?25,$J(PSATOTP,8) S X=PSATOTO,X2="2$" D COMMA^%DTC W ?55,X S X=PSATOTR,X2="2$" D COMMA^%DTC W ?70,X,!,PSADLN
- ..K PSAMORE,PSATQTYO,PSATOTP
- ..S:$O(^TMP("PSA",$J,PSACP,PSAITEM,PSAIEN)) PSAMORE=1
- ..I '$O(^TMP("PSA",$J,PSACP,PSAITEM,PSAIEN)) S ^TMP("PSAC",$J,(999999999-PSATOTO),PSAITEM)=PSATOTO_"^"_PSACP K PSATOTO
- 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 !?11,"UNPOSTED PHARMACY PROCUREMENTS FOR "_PSAMOYR_" ITEM TOTALS REPORT"
- W:$E(IOST)'="C" ! W !,PSADLN
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSALOG1 3054 printed Feb 18, 2025@23:16 Page 2
- PSALOG1 ;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 Item Totals report
- +3 ;for a selected month. This routine is called by PSALOG.
- +4 ;
- TOTALS SET (PSAPG,PSACP,PSAIEN)=0
- SET PSAITEM=""
- DO HDR
- +1 IF '$DATA(^TMP("PSA",$JOB))
- WRITE !!,"No items were found for the selected month."
- GOTO END^PSALOG0
- +2 FOR PSAC=0:1
- SET PSACP=$ORDER(^TMP("PSA",$JOB,PSACP))
- if 'PSACP!(PSAOUT)
- QUIT
- if PSAC
- DO HDR
- if PSAOUT
- GOTO END^PSALOG0
- WRITE !," << STATION/CP: "_PSACP_" >>"
- Begin DoDot:1
- +3 FOR
- SET PSAITEM=$ORDER(^TMP("PSA",$JOB,PSACP,PSAITEM))
- if PSAOUT!(PSAITEM']"")
- QUIT
- if $Y+6>IOSL
- DO HDR
- if PSAOUT
- QUIT
- FOR
- SET PSAIEN=$ORDER(^TMP("PSA",$JOB,PSACP,PSAITEM,PSAIEN))
- if PSAOUT!('PSAIEN)
- QUIT
- if $Y+4>IOSL
- DO HDR
- if PSAOUT
- QUIT
- Begin DoDot:2
- +4 SET PSATMP=$GET(^TMP("PSA",$JOB,PSACP,PSAITEM,PSAIEN))
- +5 if '$GET(PSAMORE)
- WRITE !,$EXTRACT(PSAITEM,1,50),$SELECT($PIECE(PSATMP,"^",5):" ("_$PIECE(PSATMP,"^",5)_")",1:""),?60,"NDC: ",$PIECE(PSATMP,"^",15),!," DRUG file: ",...
- ... $SELECT($PIECE($GET(^PSDRUG(+$ORDER(^PSDRUG("AB",+$PIECE(PSATMP,"^",5),0)),0)),"^")]"":$PIECE($GET(^(0)),"^"),1:"Not connected yet")
- +6 WRITE !," Vendor: ",$$VENNAME^PRCPUX1($PIECE($GET(^PRC(442,+PSAIEN,1)),"^")_"PRC(440")
- +7 SET PSAUNIT=$$UNITCODE^PRCPUX1($PIECE(PSATMP,"^",3))
- +8 IF $Y+7>IOSL
- DO HDR
- if PSAOUT
- QUIT
- +9 if '$GET(PSAMORE)
- WRITE !!," PO#",?9,"DATE",?21,"QTY",?32,"QTY",?44,"$/",PSAUNIT,?60,"TOTAL",?74,"TOTAL",!?21,"ORD",?31,"REC'D",?60,"ORD",?74,"REC'D"
- +10 WRITE !!," "_$EXTRACT($PIECE($GET(^PRC(442,+PSAIEN,0)),"^"),5,10)
- SET PSAFCP=$PIECE($GET(^(0)),"^",3)
- +11 SET Y=$PIECE($GET(^PRC(442,+PSAIEN,1)),"^",15)
- XECUTE ^DD("DD")
- SET PSADATE=$SELECT($LENGTH(Y)=10:$EXTRACT(Y,1,5),$LENGTH(Y)=11:$EXTRACT(Y,1,6),1:"UNKNOWN")
- +12 SET PSAQTYO=$PIECE(PSATMP,"^",2)
- SET PSATQTYO=$GET(PSATQTYO)+PSAQTYO
- +13 WRITE ?9,PSADATE,$JUSTIFY(PSAQTYO,8)_" ",PSAUNIT
- +14 SET PSAQTYP=$PIECE($GET(^PRC(442,+PSAIEN,2,+$ORDER(^PRC(442,+PSAIEN,2,"B",+$PIECE(PSATMP,"^"),0)),2)),"^",8)
- SET PSATOTP=$GET(PSATOTP)+PSAQTYP
- WRITE $JUSTIFY(PSAQTYP,8)_" ",PSAUNIT
- +15 SET X=$PIECE(PSATMP,"^",9)
- SET X2="2$"
- SET X3=10
- DO COMMA^%DTC
- WRITE ?40,X
- +16 SET X=PSAQTYO*$PIECE(PSATMP,"^",9)
- SET PSATOTO=$GET(PSATOTO)+X
- SET X2="2$"
- DO COMMA^%DTC
- WRITE ?56,X
- +17 SET X=PSAQTYP*$PIECE(PSATMP,"^",9)
- SET PSATOTR=$GET(PSATOTR)+X
- SET X2="2$"
- DO COMMA^%DTC
- WRITE ?70,X
- +18 WRITE !,PSASLN
- +19 IF '$ORDER(^TMP("PSA",$JOB,PSACP,PSAITEM,PSAIEN))
- IF $GET(PSAMORE)
- Begin DoDot:3
- +20 IF $Y+4>IOSL
- DO HDR
- if PSAOUT
- QUIT
- +21 WRITE !?6,"TOTALS=>",$JUSTIFY(PSATQTYO,8),?25,$JUSTIFY(PSATOTP,8)
- SET X=PSATOTO
- SET X2="2$"
- DO COMMA^%DTC
- WRITE ?55,X
- SET X=PSATOTR
- SET X2="2$"
- DO COMMA^%DTC
- WRITE ?70,X,!,PSADLN
- End DoDot:3
- if PSAOUT
- QUIT
- +22 KILL PSAMORE,PSATQTYO,PSATOTP
- +23 if $ORDER(^TMP("PSA",$JOB,PSACP,PSAITEM,PSAIEN))
- SET PSAMORE=1
- +24 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
- if PSAOUT
- GOTO END^PSALOG0
- +25 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 !?11,"UNPOSTED PHARMACY PROCUREMENTS FOR "_PSAMOYR_" ITEM TOTALS REPORT"
- +8 if $EXTRACT(IOST)'="C"
- WRITE !
- WRITE !,PSADLN
- +9 QUIT
