PSGWAR1 ;BHAM ISC/PTD,CML-Print AMIS Report ; 30 Aug 93 / 10:49 AM
;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
ENQ ;ENTRY POINT WHEN QUEUED
;BUILD SITE(ARRAY)
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")
I '$O(SITE(0)) W !!,"*** AR/WS AMIS HAS NO DATA TO PRINT ***" G DONE
F SITE=0:0 S SITE=$O(SITE(SITE)) Q:'SITE D START
DONE I $E(IOST)'="C" W @IOF
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
D ^%ZISC
S:$D(ZTQUEUED) ZTREQ="@" Q
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.
K FLD,FLDA,LOC,LOC1,SUB,SUB1
S LPDT=(BDT-1),DATDA=0 F J="03","04","05","06","07","08","17","18","22" S LOC(J)=""
DTLP S LPDT=$O(^PSI(58.5,"B",LPDT)) G:(LPDT>EDT)!('LPDT) TOTAL
DTDA S DATDA=$O(^PSI(58.5,"B",LPDT,DATDA)) G:'DATDA DTLP
S FLDA=0
FLDLP S FLDA=$O(^PSI(58.5,DATDA,"S",SITE,"AMIS",FLDA)) G:'FLDA DTDA
S FLD=$P(^PSI(58.5,DATDA,"S",SITE,"AMIS",FLDA,0),"^"),LOC1=$P(^(0),"^",2,5)
I LOC(FLD)="" S LOC(FLD)=LOC1
E F J=1:1:4 S $P(LOC(FLD),"^",J)=$P(LOC(FLD),"^",J)+$P(LOC1,"^",J)
G FLDLP
;
TOTAL ;CALCULATE AND SET PIECES 5,6,&7. SET "05", "08" & "18" NODES.
F FLD="03","04","06","07","17","22" D SETPC
S FLD="05",SUB1="03",SUB2="04" D SETOT
S FLD="08",SUB1="06",SUB2="07" D SETOT
S LOC(18)=LOC(17)
PRINT ;PRINT AMIS REPORT
D HDR^PSGWARP,SUB1^PSGWARP S FLD="03" D WRTLN S FLD="04" D WRTLN,LINE S FLD="05" D WRTLN
D SUB2^PSGWARP S FLD="06" D WRTLN S FLD="07" D WRTLN,LINE S FLD="08" D WRTLN
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
Q
SETPC S $P(LOC(FLD),"^",5)=($P(LOC(FLD),"^")-$P(LOC(FLD),"^",3))
S $P(LOC(FLD),"^",6)=($P(LOC(FLD),"^",2)-$P(LOC(FLD),"^",4))
I $P(LOC(FLD),"^",5)'=0 S $P(LOC(FLD),"^",7)=($P(LOC(FLD),"^",6)/$P(LOC(FLD),"^",5))
Q
;
SETOT F J=1:1:6 S $P(LOC(FLD),"^",J)=$P(LOC(SUB1),"^",J)+$P(LOC(SUB2),"^",J)
I $P(LOC(FLD),"^",5)'=0 S $P(LOC(FLD),"^",7)=($P(LOC(FLD),"^",6)/$P(LOC(FLD),"^",5))
Q
;
WRTLN ;PRINT A SINGLE LINE FOR SPECIFIED FIELD
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)
Q
;
LINE W ! F J=1:1:16 W " "
F J=1:1:109 W "-"
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSGWAR1 2619 printed Dec 13, 2024@01:38:49 Page 2
PSGWAR1 ;BHAM ISC/PTD,CML-Print AMIS Report ; 30 Aug 93 / 10:49 AM
+1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
ENQ ;ENTRY POINT WHEN QUEUED
+1 ;BUILD SITE(ARRAY)
+2 FOR RPDT=BDT-1:0
SET RPDT=$ORDER(^PSI(58.5,"B",RPDT))
if RPDT>EDT!('RPDT)
QUIT
FOR SITE=0:0
SET SITE=$ORDER(^PSI(58.5,RPDT,"S","B",SITE))
if 'SITE
QUIT
SET SITE(SITE)=$SELECT($DATA(^PS(59.4,SITE,0)):$PIECE(^(0),"^"),1:"UNKNOWN")
+3 IF '$ORDER(SITE(0))
WRITE !!,"*** AR/WS AMIS HAS NO DATA TO PRINT ***"
GOTO DONE
+4 FOR SITE=0:0
SET SITE=$ORDER(SITE(SITE))
if 'SITE
QUIT
DO START
DONE IF $EXTRACT(IOST)'="C"
WRITE @IOF
END KILL 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
+1 DO ^%ZISC
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
QUIT
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.
+1 KILL FLD,FLDA,LOC,LOC1,SUB,SUB1
+2 SET LPDT=(BDT-1)
SET DATDA=0
FOR J="03","04","05","06","07","08","17","18","22"
SET LOC(J)=""
DTLP SET LPDT=$ORDER(^PSI(58.5,"B",LPDT))
if (LPDT>EDT)!('LPDT)
GOTO TOTAL
DTDA SET DATDA=$ORDER(^PSI(58.5,"B",LPDT,DATDA))
if 'DATDA
GOTO DTLP
+1 SET FLDA=0
FLDLP SET FLDA=$ORDER(^PSI(58.5,DATDA,"S",SITE,"AMIS",FLDA))
if 'FLDA
GOTO DTDA
+1 SET FLD=$PIECE(^PSI(58.5,DATDA,"S",SITE,"AMIS",FLDA,0),"^")
SET LOC1=$PIECE(^(0),"^",2,5)
+2 IF LOC(FLD)=""
SET LOC(FLD)=LOC1
+3 IF '$TEST
FOR J=1:1:4
SET $PIECE(LOC(FLD),"^",J)=$PIECE(LOC(FLD),"^",J)+$PIECE(LOC1,"^",J)
+4 GOTO FLDLP
+5 ;
TOTAL ;CALCULATE AND SET PIECES 5,6,&7. SET "05", "08" & "18" NODES.
+1 FOR FLD="03","04","06","07","17","22"
DO SETPC
+2 SET FLD="05"
SET SUB1="03"
SET SUB2="04"
DO SETOT
+3 SET FLD="08"
SET SUB1="06"
SET SUB2="07"
DO SETOT
+4 SET LOC(18)=LOC(17)
PRINT ;PRINT AMIS REPORT
+1 DO HDR^PSGWARP
DO SUB1^PSGWARP
SET FLD="03"
DO WRTLN
SET FLD="04"
DO WRTLN
DO LINE
SET FLD="05"
DO WRTLN
+2 DO SUB2^PSGWARP
SET FLD="06"
DO WRTLN
SET FLD="07"
DO WRTLN
DO LINE
SET FLD="08"
DO WRTLN
+3 DO SUB3^PSGWARP
SET FLD="17"
DO WRTLN
DO LINE
SET FLD="18"
DO WRTLN
DO SUB4^PSGWARP
SET FLD="22"
DO WRTLN
DO SUMRY^PSGWARP
+4 QUIT
SETPC SET $PIECE(LOC(FLD),"^",5)=($PIECE(LOC(FLD),"^")-$PIECE(LOC(FLD),"^",3))
+1 SET $PIECE(LOC(FLD),"^",6)=($PIECE(LOC(FLD),"^",2)-$PIECE(LOC(FLD),"^",4))
+2 IF $PIECE(LOC(FLD),"^",5)'=0
SET $PIECE(LOC(FLD),"^",7)=($PIECE(LOC(FLD),"^",6)/$PIECE(LOC(FLD),"^",5))
+3 QUIT
+4 ;
SETOT FOR J=1:1:6
SET $PIECE(LOC(FLD),"^",J)=$PIECE(LOC(SUB1),"^",J)+$PIECE(LOC(SUB2),"^",J)
+1 IF $PIECE(LOC(FLD),"^",5)'=0
SET $PIECE(LOC(FLD),"^",7)=($PIECE(LOC(FLD),"^",6)/$PIECE(LOC(FLD),"^",5))
+2 QUIT
+3 ;
WRTLN ;PRINT A SINGLE LINE FOR SPECIFIED FIELD
+1 WRITE !?8,FLD,?18,$JUSTIFY($PIECE(LOC(FLD),"^"),6,0),?32,$JUSTIFY($PIECE(LOC(FLD),"^",2),10,2),?50,...
... $JUSTIFY($PIECE(LOC(FLD),"^",3),6,0),?64,$JUSTIFY($PIECE(LOC(FLD),"^",4),10,2),?82,$JUSTIFY($PIECE(LOC(FLD),"^",5),6,0),?96,$JUSTIFY($PIECE(LOC(FLD),"^",6),10,2),?114,$JUSTIFY($PIECE(LOC(FLD),"^",7),10,2)
+2 QUIT
+3 ;
LINE WRITE !
FOR J=1:1:16
WRITE " "
+1 FOR J=1:1:109
WRITE "-"
+2 QUIT
+3 ;
