PSALOG0 ;BIR/LTL,JMB-Unposted Procurement History - CONT'D ;7/23/97
;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
;This routine prints the Unposted Pharmacy Procurement report. It is
;called from PSALOG.
;
POS S (PSAPG,PSAOUT)=0,$P(PSASLN,"-",81)="",$P(PSADLN,"=",81)=""
S PSARPDT=$E($$HTFM^XLFDT($H),1,12),PSADT=$P(PSARPDT,".")
S PSARPDT=$E(PSADT,4,5)_"/"_$E(PSADT,6,7)_"/"_$E(PSADT,2,3)_"@"_$P(PSARPDT,".",2)
D HDR G:PSAOUT END
RT F S PSAYRMO=$O(^PRC(442,"AB",PSAYRMO)) Q:'PSAYRMO!($E(PSAYRMO,4,5)'=PSAMO) S PSAIEN="" D
.F S PSAIEN=+$O(^PRC(442,"AB",PSAYRMO,PSAIEN)) Q:'PSAIEN I $P($G(^PRC(442,PSAIEN,0)),"^",5)=822400,$P($G(^PRC(442,PSAIEN,7)),"^")>14&($P($G(^(7)),"^")<45) D
..S ^TMP("PSAB",$J,$E($P($G(^PRC(442,PSAIEN,0)),"^"),1,3)_$E($P($G(^PRC(442,PSAIEN,0)),"^",3),1,4),PSAIEN)=""
RTD I '$D(^TMP("PSAB",$J)) W !!,"No items were found for the selected month." G END
S PSACP=""
F S PSACP=$O(^TMP("PSAB",$J,PSACP)) Q:PSACP="" D:$Y+4>IOSL HDR G:PSAOUT END W !!,"STATION/CP: ",PSACP S PSAIEN=0 F S PSAIEN=+$O(^TMP("PSAB",$J,PSACP,PSAIEN)) Q:'PSAIEN D:$Y+4>IOSL HDR G:PSAOUT END D
.S PSAN0=$G(^PRC(442,PSAIEN,0))
.W !,$E($P(PSAN0,"^"),5,10)
.S PSAN1=$G(^PRC(442,PSAIEN,1)),PSADT=$P(PSAN1,"^",15)
.S Y=PSADT X ^DD("DD") W ?10,Y
.W ?22,$E($P(PSAN0,"^",3),1,3),?27,$E($$VENNAME^PRCPUX1($P(PSAN1,"^")_"PRC(440"),1,30)
.S X=$P(PSAN0,"^",15),PSATOT=$G(PSATOT)+X,X2="2$",X3=10 D COMMA^%DTC
.W ?69,X
.Q:'$D(^PRC(442,PSAIEN,2,0)) S PSAITEM=0
.F S PSAITEM=+$O(^PRC(442,PSAIEN,2,PSAITEM)) Q:'PSAITEM D
..S:$G(^PRC(442,PSAIEN,2,PSAITEM,1,1,0))]"" ^TMP("PSA",$J,PSACP,$E($G(^PRC(442,PSAIEN,2,PSAITEM,1,1,0)),1,65),PSAIEN)=$G(^PRC(442,PSAIEN,2,PSAITEM,0))
.I $G(PSATOT),'$O(^TMP("PSAB",$J,PSACP,PSAIEN)) S X=PSATOT,X2="2$",X3=10 D COMMA^%DTC S PSACOST=X D Q:PSAOUT
..D:$Y+5>IOSL HDR Q:PSAOUT
..W !,PSADLN,!,?57,"TOTAL COST: ",PSACOST K PSATOT
END W:$E(IOST)'="C" @IOF
I $E(IOST,1,2)="C-",'$G(PSAOUT) D
.S PSASS=22-$Y F PSAKK=1:1:PSASS W !
.S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to continue." D ^DIR K DIR S:'Y PSAOUT=1
Q
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 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 !?19,"UNPOSTED PHARMACY PROCUREMENTS FOR ",PSAMOYR
W !!,"PO #",?10,"PO DATE",?22,"CP",?27,"VENDOR",?69,"TOTAL COST",!,PSADLN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSALOG0 2561 printed Apr 09, 2024@20:55:30 Page 2
PSALOG0 ;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 Unposted Pharmacy Procurement report. It is
+3 ;called from PSALOG.
+4 ;
POS SET (PSAPG,PSAOUT)=0
SET $PIECE(PSASLN,"-",81)=""
SET $PIECE(PSADLN,"=",81)=""
+1 SET PSARPDT=$EXTRACT($$HTFM^XLFDT($HOROLOG),1,12)
SET PSADT=$PIECE(PSARPDT,".")
+2 SET PSARPDT=$EXTRACT(PSADT,4,5)_"/"_$EXTRACT(PSADT,6,7)_"/"_$EXTRACT(PSADT,2,3)_"@"_$PIECE(PSARPDT,".",2)
+3 DO HDR
if PSAOUT
GOTO END
RT FOR
SET PSAYRMO=$ORDER(^PRC(442,"AB",PSAYRMO))
if 'PSAYRMO!($EXTRACT(PSAYRMO,4,5)'=PSAMO)
QUIT
SET PSAIEN=""
Begin DoDot:1
+1 FOR
SET PSAIEN=+$ORDER(^PRC(442,"AB",PSAYRMO,PSAIEN))
if 'PSAIEN
QUIT
IF $PIECE($GET(^PRC(442,PSAIEN,0)),"^",5)=822400
IF $PIECE($GET(^PRC(442,PSAIEN,7)),"^")>14&($PIECE($GET(^(7)),"^")<45)
Begin DoDot:2
+2 SET ^TMP("PSAB",$JOB,$EXTRACT($PIECE($GET(^PRC(442,PSAIEN,0)),"^"),1,3)_$EXTRACT($PIECE($GET(^PRC(442,PSAIEN,0)),"^",3),1,4),PSAIEN)=""
End DoDot:2
End DoDot:1
RTD IF '$DATA(^TMP("PSAB",$JOB))
WRITE !!,"No items were found for the selected month."
GOTO END
+1 SET PSACP=""
+2 FOR
SET PSACP=$ORDER(^TMP("PSAB",$JOB,PSACP))
if PSACP=""
QUIT
if $Y+4>IOSL
DO HDR
if PSAOUT
GOTO END
WRITE !!,"STATION/CP: ",PSACP
SET PSAIEN=0
FOR
SET PSAIEN=+$ORDER(^TMP("PSAB",$JOB,PSACP,PSAIEN))
if 'PSAIEN
QUIT
if $Y+4>IOSL
DO HDR
if PSAOUT
GOTO END
Begin DoDot:1
+3 SET PSAN0=$GET(^PRC(442,PSAIEN,0))
+4 WRITE !,$EXTRACT($PIECE(PSAN0,"^"),5,10)
+5 SET PSAN1=$GET(^PRC(442,PSAIEN,1))
SET PSADT=$PIECE(PSAN1,"^",15)
+6 SET Y=PSADT
XECUTE ^DD("DD")
WRITE ?10,Y
+7 WRITE ?22,$EXTRACT($PIECE(PSAN0,"^",3),1,3),?27,$EXTRACT($$VENNAME^PRCPUX1($PIECE(PSAN1,"^")_"PRC(440"),1,30)
+8 SET X=$PIECE(PSAN0,"^",15)
SET PSATOT=$GET(PSATOT)+X
SET X2="2$"
SET X3=10
DO COMMA^%DTC
+9 WRITE ?69,X
+10 if '$DATA(^PRC(442,PSAIEN,2,0))
QUIT
SET PSAITEM=0
+11 FOR
SET PSAITEM=+$ORDER(^PRC(442,PSAIEN,2,PSAITEM))
if 'PSAITEM
QUIT
Begin DoDot:2
+12 if $GET(^PRC(442,PSAIEN,2,PSAITEM,1,1,0))]""
SET ^TMP("PSA",$JOB,PSACP,$EXTRACT($GET(^PRC(442,PSAIEN,2,PSAITEM,1,1,0)),1,65),PSAIEN)=$GET(^PRC(442,PSAIEN,2,PSAITEM,0))
End DoDot:2
+13 IF $GET(PSATOT)
IF '$ORDER(^TMP("PSAB",$JOB,PSACP,PSAIEN))
SET X=PSATOT
SET X2="2$"
SET X3=10
DO COMMA^%DTC
SET PSACOST=X
Begin DoDot:2
+14 if $Y+5>IOSL
DO HDR
if PSAOUT
QUIT
+15 WRITE !,PSADLN,!,?57,"TOTAL COST: ",PSACOST
KILL PSATOT
End DoDot:2
if PSAOUT
QUIT
End DoDot:1
END if $EXTRACT(IOST)'="C"
WRITE @IOF
+1 IF $EXTRACT(IOST,1,2)="C-"
IF '$GET(PSAOUT)
Begin DoDot:1
+2 SET PSASS=22-$Y
FOR PSAKK=1:1:PSASS
WRITE !
+3 SET DIR(0)="EA"
SET DIR("A")="END OF REPORT! Press <RET> to return to continue."
DO ^DIR
KILL DIR
if 'Y
SET PSAOUT=1
End DoDot:1
+4 QUIT
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
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 !?19,"UNPOSTED PHARMACY PROCUREMENTS FOR ",PSAMOYR
+8 WRITE !!,"PO #",?10,"PO DATE",?22,"CP",?27,"VENDOR",?69,"TOTAL COST",!,PSADLN
+9 QUIT
