- PSDPWK3 ;BIR/JPW-Print Pharm Disp. Worksheet (Summary) ; 23 Jun 94
- ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- D NOW^%DTC S Y=+$E(%,1,12) X ^DD("DD") S RPDT=Y
- S (PG,PSDOUT)=0
- I '$D(^TMP("PSDWKT",$J)) D HDR W !!,?45,"**** NO PENDING REQUESTS FOR THIS DISPENSING LOCATION ****" Q
- PRINT ;prints data for worksheet
- D HDR Q:PSDOUT
- S LOOP="" F S LOOP=$O(^TMP("PSDWKT",$J,LOOP)) Q:LOOP=""!(PSDOUT) W !,?2,"=> ",LOOP D:$Y+4>IOSL HDR Q:PSDOUT D
- .S LOOP2="" F S LOOP2=$O(^TMP("PSDWKT",$J,LOOP,LOOP2)) Q:LOOP2=""!(PSDOUT) D:$Y+4>IOSL HDR Q:PSDOUT W !,LOOP2,?60,+^TMP("PSDWKT",$J,LOOP,LOOP2),!
- DONE I SUM,$E(IOST)'="C" W @IOF
- Q
- HDR ;lists header information
- I $E(IOST,1,2)="C-",PG W ! K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
- K LN S $P(LN,"-",80)=""
- W:$Y @IOF S PG=PG+1 W !,?22,"PHARMACY DISPENSING WORKSHEET",?70,"PG "_PG,!,?29,"** SUMMARY **",!,?27,RPDT,!!,"Dispensing Location: ",PSDSN,!!
- W ?2,"=> DRUG",!,"NAOU",?55,"TOTAL TO DISPENSE",!,LN,!
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDPWK3 984 printed Feb 18, 2025@23:14:44 Page 2
- PSDPWK3 ;BIR/JPW-Print Pharm Disp. Worksheet (Summary) ; 23 Jun 94
- +1 ;;3.0; CONTROLLED SUBSTANCES ;;13 Feb 97
- +2 DO NOW^%DTC
- SET Y=+$EXTRACT(%,1,12)
- XECUTE ^DD("DD")
- SET RPDT=Y
- +3 SET (PG,PSDOUT)=0
- +4 IF '$DATA(^TMP("PSDWKT",$JOB))
- DO HDR
- WRITE !!,?45,"**** NO PENDING REQUESTS FOR THIS DISPENSING LOCATION ****"
- QUIT
- PRINT ;prints data for worksheet
- +1 DO HDR
- if PSDOUT
- QUIT
- +2 SET LOOP=""
- FOR
- SET LOOP=$ORDER(^TMP("PSDWKT",$JOB,LOOP))
- if LOOP=""!(PSDOUT)
- QUIT
- WRITE !,?2,"=> ",LOOP
- if $Y+4>IOSL
- DO HDR
- if PSDOUT
- QUIT
- Begin DoDot:1
- +3 SET LOOP2=""
- FOR
- SET LOOP2=$ORDER(^TMP("PSDWKT",$JOB,LOOP,LOOP2))
- if LOOP2=""!(PSDOUT)
- QUIT
- if $Y+4>IOSL
- DO HDR
- if PSDOUT
- QUIT
- WRITE !,LOOP2,?60,+^TMP("PSDWKT",$JOB,LOOP,LOOP2),!
- End DoDot:1
- DONE IF SUM
- IF $EXTRACT(IOST)'="C"
- WRITE @IOF
- +1 QUIT
- HDR ;lists header information
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF PG
- WRITE !
- KILL DA,DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSDOUT=1
- QUIT
- +2 KILL LN
- SET $PIECE(LN,"-",80)=""
- +3 if $Y
- WRITE @IOF
- SET PG=PG+1
- WRITE !,?22,"PHARMACY DISPENSING WORKSHEET",?70,"PG "_PG,!,?29,"** SUMMARY **",!,?27,RPDT,!!,"Dispensing Location: ",PSDSN,!!
- +4 WRITE ?2,"=> DRUG",!,"NAOU",?55,"TOTAL TO DISPENSE",!,LN,!
- +5 QUIT