- PSGWADP1 ;BHAM ISC/PTD,CML-Print Data for AMIS Stats - CONTINUED ; 30 Aug 93 / 10:13 AM
- ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- PRINT S PSGWPG=1,OUT=0 D HDR G:OUT END
- F PSGWTY=0:0 Q:OUT S PSGWTY=$O(^TMP("PSGWADP",$J,PSGWTY)),PSGWNM=0 G:PSGWTY=9999 ONDM G:'PSGWTY DONE D:$Y+5>IOSL HDR I 'OUT D WRTYPE F J=0:0 S PSGWNM=$O(^TMP("PSGWADP",$J,PSGWTY,PSGWNM)) Q:PSGWNM=""!(OUT) D
- .D:$Y+5>IOSL HDR I 'OUT W !!?5,PSGWNM D WRTDATA
- ;
- ONDM I 'OUT S PSGWNM=0 D:$Y+5>IOSL HDR I 'OUT D WRTYPE F J=0:0 S PSGWNM=$O(^TMP("PSGWADP",$J,9999,PSGWNM)) Q:PSGWNM=""!(OUT) I '$D(^TMP("PSGWADP",$J,"DN",PSGWNM)) D:$Y+5>IOSL HDR I 'OUT W !!?5,PSGWNM D WRTDATA
- ;
- DONE I $E(IOST)'="C" W @IOF
- I $E(IOST)="C"&('OUT) W !!,"Press RETURN to continue: " R AUTO:DTIME
- END K ^TMP("PSGWADP",$J),I,J,K,PSGWAOU,PSGWDR,PSGWITM,PSGWNM,PSGWTY,PSGWPG,LOC,LOC1,LOC2,OUPTR,OUNIT,PSGWIO,ZTSK,PSGWDT,%,%I,%H,DA,ZTIO,%DT,IO("Q"),X,Y,AUTO,OUT
- D ^%ZISC
- S:$D(ZTQUEUED) ZTREQ="@" Q
- ;
- HDR ;PRINT REPORT HEADING
- I $E(IOST)="C"&(PSGWPG>1) S DIR(0)="E" D ^DIR K DIR I Y'=1 S OUT=1 Q
- W:$Y @IOF S %DT="",X="T" D ^%DT X ^DD("DD") W !!,"PAGE: ",PSGWPG,?110,"DATE: ",Y,!?50,"DATA FOR AR/WS AMIS STATS",!!,"TYPE",?47,"ORDER",?59,"PRICE PER",?73,"DISPENSE UNITS",?90,"PRICE PER",?105,"AMIS",?120,"AMIS CONV.",!
- W ?5,"DRUG NAME",?47,"UNIT",?59,"ORDER UNIT",?73,"PER ORDER UNIT",?90,"DISPENSE UNIT",?105,"CATEGORY",?120,"NUMBER",!
- F J=1:1:132 W "="
- S PSGWPG=PSGWPG+1
- Q
- ;
- WRTYPE W !!,$S((PSGWTY'=9999)&($D(^PSI(58.16,PSGWTY,0))):$P(^PSI(58.16,PSGWTY,0),"^"),1:"** UNCLASSIFIED BY TYPE: ") Q
- ;
- WRTDATA S LOC=^TMP("PSGWADP",$J,PSGWTY,PSGWNM) F J=1:1:6 I $P(LOC,"^",J)="" S $P(LOC,"^",J)="NO DATA"
- W ?47,$P(LOC,"^"),?61,$P(LOC,"^",2),?75,$P(LOC,"^",3),?90,$P(LOC,"^",4),?105,$P(LOC,"^",5),?120,$P(LOC,"^",6)
- Q
- PSGWADP1 ;BHAM ISC/PTD,CML-Print Data for AMIS Stats - CONTINUED ; 30 Aug 93 / 10:13 AM
- +1 ;;2.3; Automatic Replenishment/Ward Stock ;;4 JAN 94
- PRINT SET PSGWPG=1
- SET OUT=0
- DO HDR
- IF OUT
- GOTO END
- +1 FOR PSGWTY=0:0
- IF OUT
- QUIT
- SET PSGWTY=$ORDER(^TMP("PSGWADP",$JOB,PSGWTY))
- SET PSGWNM=0
- IF PSGWTY=9999
- GOTO ONDM
- IF 'PSGWTY
- GOTO DONE
- IF $Y+5>IOSL
- DO HDR
- IF 'OUT
- DO WRTYPE
- FOR J=0:0
- SET PSGWNM=$ORDER(^TMP("PSGWADP",$JOB,PSGWTY,PSGWNM))
- IF PSGWNM=""!(OUT)
- QUIT
- Begin DoDot:1
- +2 IF $Y+5>IOSL
- DO HDR
- IF 'OUT
- WRITE !!?5,PSGWNM
- DO WRTDATA
- End DoDot:1
- +3 ;
- ONDM IF 'OUT
- SET PSGWNM=0
- IF $Y+5>IOSL
- DO HDR
- IF 'OUT
- DO WRTYPE
- FOR J=0:0
- SET PSGWNM=$ORDER(^TMP("PSGWADP",$JOB,9999,PSGWNM))
- IF PSGWNM=""!(OUT)
- QUIT
- IF '$DATA(^TMP("PSGWADP",$JOB,"DN",PSGWNM))
- IF $Y+5>IOSL
- DO HDR
- IF 'OUT
- WRITE !!?5,PSGWNM
- DO WRTDATA
- +1 ;
- DONE IF $EXTRACT(IOST)'="C"
- WRITE @IOF
- +1 IF $EXTRACT(IOST)="C"&('OUT)
- WRITE !!,"Press RETURN to continue: "
- READ AUTO:DTIME
- END KILL ^TMP("PSGWADP",$JOB),I,J,K,PSGWAOU,PSGWDR,PSGWITM,PSGWNM,PSGWTY,PSGWPG,LOC,LOC1,LOC2,OUPTR,OUNIT,PSGWIO,ZTSK,PSGWDT,%,%I,%H,DA,ZTIO,%DT,IO("Q"),X,Y,AUTO,OUT
- +1 DO ^%ZISC
- +2 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +3 ;
- HDR ;PRINT REPORT HEADING
- +1 IF $EXTRACT(IOST)="C"&(PSGWPG>1)
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF Y'=1
- SET OUT=1
- QUIT
- +2 IF $Y
- WRITE @IOF
- SET %DT=""
- SET X="T"
- DO ^%DT
- XECUTE ^DD("DD")
- WRITE !!,"PAGE: ",PSGWPG,?110,"DATE: ",Y,!?50,"DATA FOR AR/WS AMIS STATS",!!,"TYPE",?47,"ORDER",?59,"PRICE PER",?73,"DISPENSE UNITS",?90,"PRICE PER",?105,"AMIS",?120,"AMIS CONV.",!
- +3 WRITE ?5,"DRUG NAME",?47,"UNIT",?59,"ORDER UNIT",?73,"PER ORDER UNIT",?90,"DISPENSE UNIT",?105,"CATEGORY",?120,"NUMBER",!
- +4 FOR J=1:1:132
- WRITE "="
- +5 SET PSGWPG=PSGWPG+1
- +6 QUIT
- +7 ;
- WRTYPE WRITE !!,$SELECT((PSGWTY'=9999)&($DATA(^PSI(58.16,PSGWTY,0))):$PIECE(^PSI(58.16,PSGWTY,0),"^"),1:"** UNCLASSIFIED BY TYPE: ")
- QUIT
- +1 ;
- WRTDATA SET LOC=^TMP("PSGWADP",$JOB,PSGWTY,PSGWNM)
- FOR J=1:1:6
- IF $PIECE(LOC,"^",J)=""
- SET $PIECE(LOC,"^",J)="NO DATA"
- +1 WRITE ?47,$PIECE(LOC,"^"),?61,$PIECE(LOC,"^",2),?75,$PIECE(LOC,"^",3),?90,$PIECE(LOC,"^",4),?105,$PIECE(LOC,"^",5),?120,$PIECE(LOC,"^",6)
- +2 QUIT
