| [613] | 1 | PSGWAR1 ;BHAM ISC/PTD,CML-Print AMIS Report ; 30 Aug 93 / 10:49 AM
|
|---|
| 2 | ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
|
|---|
| 3 | ENQ ;ENTRY POINT WHEN QUEUED
|
|---|
| 4 | ;BUILD SITE(ARRAY)
|
|---|
| 5 | F RPDT=BDT-1:0 S RPDT=$O(^PSI(58.5,"B",RPDT)) Q:RPDT>EDT!('RPDT) F SITE=0:0 S SITE=$O(^PSI(58.5,RPDT,"S","B",SITE)) Q:'SITE S SITE(SITE)=$S($D(^PS(59.4,SITE,0)):$P(^(0),"^"),1:"UNKNOWN")
|
|---|
| 6 | I '$O(SITE(0)) W !!,"*** AR/WS AMIS HAS NO DATA TO PRINT ***" G DONE
|
|---|
| 7 | F SITE=0:0 S SITE=$O(SITE(SITE)) Q:'SITE D START
|
|---|
| 8 | DONE I $E(IOST)'="C" W @IOF
|
|---|
| 9 | END K ZTSK,ADT,AOU,BDT,CURDT,DATDA,EDT,FLD,FLDA,J,G,LOC,LOC1,LPDT,RPDT,SITE,SUB1,SUB2,X,Y,UPDT,%H,%I,IO("Q"),%,LL,LN
|
|---|
| 10 | D ^%ZISC
|
|---|
| 11 | S:$D(ZTQUEUED) ZTREQ="@" Q
|
|---|
| 12 | START ;LOOP THROUGH "B" CROSS-REFERENCE AND ^PSI(58.5,DATDA,"S",SITE,"AMIS",FLDA). FOR EACH DATE SELECTED, LOOP THROUGH THE FIELDS AND ADD TOTALS TO LOCAL ARRAY.
|
|---|
| 13 | K FLD,FLDA,LOC,LOC1,SUB,SUB1
|
|---|
| 14 | S LPDT=(BDT-1),DATDA=0 F J="03","04","05","06","07","08","17","18","22" S LOC(J)=""
|
|---|
| 15 | DTLP S LPDT=$O(^PSI(58.5,"B",LPDT)) G:(LPDT>EDT)!('LPDT) TOTAL
|
|---|
| 16 | DTDA S DATDA=$O(^PSI(58.5,"B",LPDT,DATDA)) G:'DATDA DTLP
|
|---|
| 17 | S FLDA=0
|
|---|
| 18 | FLDLP S FLDA=$O(^PSI(58.5,DATDA,"S",SITE,"AMIS",FLDA)) G:'FLDA DTDA
|
|---|
| 19 | S FLD=$P(^PSI(58.5,DATDA,"S",SITE,"AMIS",FLDA,0),"^"),LOC1=$P(^(0),"^",2,5)
|
|---|
| 20 | I LOC(FLD)="" S LOC(FLD)=LOC1
|
|---|
| 21 | E F J=1:1:4 S $P(LOC(FLD),"^",J)=$P(LOC(FLD),"^",J)+$P(LOC1,"^",J)
|
|---|
| 22 | G FLDLP
|
|---|
| 23 | ;
|
|---|
| 24 | TOTAL ;CALCULATE AND SET PIECES 5,6,&7. SET "05", "08" & "18" NODES.
|
|---|
| 25 | F FLD="03","04","06","07","17","22" D SETPC
|
|---|
| 26 | S FLD="05",SUB1="03",SUB2="04" D SETOT
|
|---|
| 27 | S FLD="08",SUB1="06",SUB2="07" D SETOT
|
|---|
| 28 | S LOC(18)=LOC(17)
|
|---|
| 29 | PRINT ;PRINT AMIS REPORT
|
|---|
| 30 | D HDR^PSGWARP,SUB1^PSGWARP S FLD="03" D WRTLN S FLD="04" D WRTLN,LINE S FLD="05" D WRTLN
|
|---|
| 31 | D SUB2^PSGWARP S FLD="06" D WRTLN S FLD="07" D WRTLN,LINE S FLD="08" D WRTLN
|
|---|
| 32 | D SUB3^PSGWARP S FLD="17" D WRTLN,LINE S FLD="18" D WRTLN D SUB4^PSGWARP S FLD="22" D WRTLN D SUMRY^PSGWARP
|
|---|
| 33 | Q
|
|---|
| 34 | SETPC S $P(LOC(FLD),"^",5)=($P(LOC(FLD),"^")-$P(LOC(FLD),"^",3))
|
|---|
| 35 | S $P(LOC(FLD),"^",6)=($P(LOC(FLD),"^",2)-$P(LOC(FLD),"^",4))
|
|---|
| 36 | I $P(LOC(FLD),"^",5)'=0 S $P(LOC(FLD),"^",7)=($P(LOC(FLD),"^",6)/$P(LOC(FLD),"^",5))
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | SETOT F J=1:1:6 S $P(LOC(FLD),"^",J)=$P(LOC(SUB1),"^",J)+$P(LOC(SUB2),"^",J)
|
|---|
| 40 | I $P(LOC(FLD),"^",5)'=0 S $P(LOC(FLD),"^",7)=($P(LOC(FLD),"^",6)/$P(LOC(FLD),"^",5))
|
|---|
| 41 | Q
|
|---|
| 42 | ;
|
|---|
| 43 | WRTLN ;PRINT A SINGLE LINE FOR SPECIFIED FIELD
|
|---|
| 44 | W !?8,FLD,?18,$J($P(LOC(FLD),"^"),6,0),?32,$J($P(LOC(FLD),"^",2),10,2),?50,$J($P(LOC(FLD),"^",3),6,0),?64,$J($P(LOC(FLD),"^",4),10,2),?82,$J($P(LOC(FLD),"^",5),6,0),?96,$J($P(LOC(FLD),"^",6),10,2),?114,$J($P(LOC(FLD),"^",7),10,2)
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | LINE W ! F J=1:1:16 W " "
|
|---|
| 48 | F J=1:1:109 W "-"
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
