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