source: FOIAVistA/trunk/r/DRUG_ACCOUNTABILITY-PSA/PSALOG0.m@ 1397

Last change on this file since 1397 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1PSALOG0 ;BIR/LTL,JMB-Unposted Procurement History - CONT'D ;7/23/97
2 ;;3.0; DRUG ACCOUNTABILITY/INVENTORY INTERFACE;; 10/24/97
3 ;This routine prints the Unposted Pharmacy Procurement report. It is
4 ;called from PSALOG.
5 ;
6POS S (PSAPG,PSAOUT)=0,$P(PSASLN,"-",81)="",$P(PSADLN,"=",81)=""
7 S PSARPDT=$E($$HTFM^XLFDT($H),1,12),PSADT=$P(PSARPDT,".")
8 S PSARPDT=$E(PSADT,4,5)_"/"_$E(PSADT,6,7)_"/"_$E(PSADT,2,3)_"@"_$P(PSARPDT,".",2)
9 D HDR G:PSAOUT END
10RT F S PSAYRMO=$O(^PRC(442,"AB",PSAYRMO)) Q:'PSAYRMO!($E(PSAYRMO,4,5)'=PSAMO) S PSAIEN="" D
11 .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
12 ..S ^TMP("PSAB",$J,$E($P($G(^PRC(442,PSAIEN,0)),"^"),1,3)_$E($P($G(^PRC(442,PSAIEN,0)),"^",3),1,4),PSAIEN)=""
13RTD I '$D(^TMP("PSAB",$J)) W !!,"No items were found for the selected month." G END
14 S PSACP=""
15 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
16 .S PSAN0=$G(^PRC(442,PSAIEN,0))
17 .W !,$E($P(PSAN0,"^"),5,10)
18 .S PSAN1=$G(^PRC(442,PSAIEN,1)),PSADT=$P(PSAN1,"^",15)
19 .S Y=PSADT X ^DD("DD") W ?10,Y
20 .W ?22,$E($P(PSAN0,"^",3),1,3),?27,$E($$VENNAME^PRCPUX1($P(PSAN1,"^")_"PRC(440"),1,30)
21 .S X=$P(PSAN0,"^",15),PSATOT=$G(PSATOT)+X,X2="2$",X3=10 D COMMA^%DTC
22 .W ?69,X
23 .Q:'$D(^PRC(442,PSAIEN,2,0)) S PSAITEM=0
24 .F S PSAITEM=+$O(^PRC(442,PSAIEN,2,PSAITEM)) Q:'PSAITEM D
25 ..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))
26 .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
27 ..D:$Y+5>IOSL HDR Q:PSAOUT
28 ..W !,PSADLN,!,?57,"TOTAL COST: ",PSACOST K PSATOT
29END W:$E(IOST)'="C" @IOF
30 I $E(IOST,1,2)="C-",'$G(PSAOUT) D
31 .S PSASS=22-$Y F PSAKK=1:1:PSASS W !
32 .S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to continue." D ^DIR K DIR S:'Y PSAOUT=1
33 Q
34HDR I $E(IOST,1,2)="C-",PSAPG D Q:PSAOUT
35 .S PSASS=22-$Y F PSAKK=1:1:PSASS W !
36 .S DIR(0)="E" D ^DIR K DIR S:'Y PSAOUT=1
37 I $$S^%ZTLOAD S PSAOUT=1 Q
38 W:$Y @IOF S PSAPG=PSAPG+1
39 W:$E(IOST)'="C" !!,PSARPDT W:$E(IOST,1,2)="C-" !
40 W ?20,"DRUG ACCOUNTABILITY/INVENTORY INTERFACE",?72,"PAGE ",$J(PSAPG,2)
41 W !?19,"UNPOSTED PHARMACY PROCUREMENTS FOR ",PSAMOYR
42 W !!,"PO #",?10,"PO DATE",?22,"CP",?27,"VENDOR",?69,"TOTAL COST",!,PSADLN
43 Q
Note: See TracBrowser for help on using the repository browser.