- 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
- ;
- 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 ;
