source: FOIAVistA/trunk/r/AUTO_REPLENISHMENT_WARD_STOCK-PSGW/PSGWAR1.m@ 1274

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

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1PSGWAR1 ;BHAM ISC/PTD,CML-Print AMIS Report ; 30 Aug 93 / 10:49 AM
2 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
3ENQ ;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
8DONE I $E(IOST)'="C" W @IOF
9END 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
12START ;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)=""
15DTLP S LPDT=$O(^PSI(58.5,"B",LPDT)) G:(LPDT>EDT)!('LPDT) TOTAL
16DTDA S DATDA=$O(^PSI(58.5,"B",LPDT,DATDA)) G:'DATDA DTLP
17 S FLDA=0
18FLDLP 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 ;
24TOTAL ;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)
29PRINT ;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
34SETPC 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 ;
39SETOT 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 ;
43WRTLN ;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 ;
47LINE W ! F J=1:1:16 W " "
48 F J=1:1:109 W "-"
49 Q
50 ;
Note: See TracBrowser for help on using the repository browser.