source: WorldVistAEHR/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWDR.m@ 1763

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1PSGWDR ;BHAM ISC/PTD,CML-Returns Breakdown Report for Selected Date Range ; 30 Aug 93 / 10:49 AM
2 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
3BDT S %DT="AEX",%DT("A")="BEGINNING date for report: " D ^%DT K %DT G:Y<0 END S BDT=Y
4EDT S %DT="AEX",%DT(0)=BDT,%DT("A")="ENDING date for report: " D ^%DT K %DT G:Y<0 END S EDT=Y
5 D SEL^PSGWUTL1 G:'$D(SEL) END G:SEL="I" EN
6ASKAOU F JJ=0:0 S DIC="^PSI(58.1,",DIC(0)="QEAM" D ^DIC K DIC Q:Y<0 S AOULP(+Y)=""
7 I '$D(AOULP)&(X'="^ALL") G END
8 I X="^ALL" F AOU=0:0 S AOU=$O(^PSI(58.1,AOU)) Q:'AOU S AOULP(AOU)=""
9EN G:'$D(AOULP) END W !!,"The right margin for this report is 80.",!,"You may queue the report to print at a later time.",!!
10DEV K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED!" G END
11 I $D(IO("Q")) K IO("Q") S ZTRTN="ENQ^PSGWDR",ZTDESC="Print Returns Analysis" S:$D(AOULP) ZTSAVE("AOULP(")="" F G="BDT","EDT","ALL","SEL","IGDA" S:$D(@G) ZTSAVE(G)=""
12 I D ^%ZTLOAD,HOME^%ZIS K ZTSK G END
13 U IO
14 ;
15ENQ ;ENTRY POINT WHEN QUEUED
16 K ^TMP("PSGWRET",$J) S PGCT=1,AOU=""
17AOU S AOU=$O(AOULP(AOU)) G:'AOU PRINT
18DRUG ;LOOP THROUGH DRUGS FOR AOU
19 S DRGDA=0
20DRGLP S DRGDA=$O(^PSI(58.1,AOU,1,DRGDA)) G:'DRGDA AOU S DRGNM=$P(^PSI(58.1,AOU,1,DRGDA,0),"^")
21 I '$O(^PSDRUG(DRGNM,0)) S DIK="^PSI(58.1,"_AOU_",1,",DA=DRGDA,DA(1)=AOU D ^DIK K DIK G DRGLP
22 S DRGNAME=$P(^PSDRUG(DRGNM,0),"^")
23 ;
24RET ;RETURNS
25 S RETDT=0
26RETLP S RETDT=$O(^PSI(58.1,AOU,1,DRGDA,3,RETDT)) G:'RETDT DRGLP I (RETDT'<BDT)&(RETDT'>EDT) D SET
27 G RETLP
28 ;
29PRINT ;
30 S AOU=0,QFLG="" I '$O(^TMP("PSGWRET",$J,0)) D HDR W !,"NO RETURNS FOR SELECTED DATE RANGE." G DONE
31AOULP S AOU=$O(^TMP("PSGWRET",$J,AOU)) G:'AOU DONE I PGCT>1 D PRTCHK G:QFLG END
32 D:PGCT<2 HDR W !?5,"==> ",$P(^PSI(58.1,AOU,0),"^") S DRG=0 I $D(^PSI(58.1,AOU,"I")),^("I")]"",^("I")'>DT W " *** INACTIVE ***"
33DRLP S DRG=$O(^TMP("PSGWRET",$J,AOU,DRG)),RET=0 G:DRG="" AOULP D:$Y+5>IOSL PRTCHK G:QFLG END W !!,"----------",!,DRG
34RLP S RET=$O(^TMP("PSGWRET",$J,AOU,DRG,RET)) G:'RET DRLP S LOCR=^TMP("PSGWRET",$J,AOU,DRG,RET),LOCQD=$P(LOCR,"^"),LOCRSN=$P(LOCR,"^",2),Y=RET X ^DD("DD") S RETPRT=Y
35 S:LOCRSN]"" CNT=$L(LOCRSN,";;") I LOCRSN="" S LOCRSN=";;",CNT=1
36 D:$Y+5>IOSL PRTCHK G:QFLG END W !?35,RETPRT,?51,$J(LOCQD,4) S RSN=$P(LOCRSN,";;",2) D RSN W ?65,RSN
37 I CNT>2 F LL=3:1:CNT S RSN=$P(LOCRSN,";;",LL) D RSN D:$Y+5>IOSL PRTCHK W !?65,RSN
38 G RLP
39 ;
40DONE I $E(IOST)'="C" W @IOF
41 I $E(IOST)="C" D:'QFLG SS^PSGWUTL1
42END K ZTSK,^TMP("PSGWRET",$J),AOU,AOULP,ANS,CNT,QFLG,JJ,LL,ALL,BDT,DRG,DRGDA,DRGNAME,DRGNM,EDT,J,LOC,LOCQD,LOCR,LOCRSN,SEL,IGDA,RET,RSN,PGCT,QD,RETDT,RETPRT,%,%I,%H,DA,G,X,Y,IO("Q") D ^%ZISC
43 S:$D(ZTQUEUED) ZTREQ="@" Q
44 ;
45HDR ;PRINT REPORT HEADER
46 W:$Y @IOF W !,"RETURNS BREAKDOWN REPORT FROM " S Y=BDT X ^DD("DD") W Y," TO " S Y=EDT X ^DD("DD") W Y,?70,"PAGE ",PGCT I $D(SEL),SEL="I",$D(IGDA) W !,"FOR INVENTORY GROUP - ",$P(^PSI(58.2,IGDA,0),"^")
47 W !!?5,"AREA OF USE" W ?55,"DATE: ",$$PSGWDT^PSGWUTL1,!
48 W !?37,"RETURN",?50,"QUANTITY",?65,"RETURN",!?14,"ITEM",?38,"DATE",?50,"RETURNED",?65,"REASON",! S PGCT=PGCT+1 F J=1:1:80 W "-"
49 Q
50SET ;
51 S QD=$P(^PSI(58.1,AOU,1,DRGDA,3,RETDT,0),"^",2),RSN="" F LL=0:0 S LL=$O(^PSI(58.1,AOU,1,DRGDA,3,RETDT,1,LL)) Q:'LL I ^PSI(58.1,AOU,1,DRGDA,3,RETDT,1,LL,0)]"" S RSN=RSN_";;"_^(0)
52 S:QD'<1 ^TMP("PSGWRET",$J,AOU,DRGNAME,RETDT)=QD_"^"_RSN Q
53RSN S RSN=$S(RSN="E":"EXPIRED",RSN="O":"OVER STOCK",RSN="D":"DEL FR STOCK",RSN="C":"CHG STOCK LEV",1:"NOT LISTED") Q
54PRTCHK ;
55 I $E(IOST)="C" W !!,"Press <RETURN> to Continue or ""^"" to Exit: " R ANS:DTIME S:'$T ANS="^" D:ANS?1."?" HELP^PSGWUTL1 I ANS="^" S QFLG=1 Q
56 D HDR Q
Note: See TracBrowser for help on using the repository browser.