- PSDACT2 ;BIR/JPW-Print Daily Activity Log (cont'd) ; 2 Aug 94
- ;;3.0; CONTROLLED SUBSTANCES ;**30**;13 Feb 97
- PRINT ;prints data
- K LN S (CNT,FLAG,PG,PSDOUT)=0,$P(LN,"-",132)=""
- I '$D(^TMP("PSDACT",$J)) D HDR W !!,?15,"**** NO DAILY ACTIVITY ****",!! G DONE
- S PSDRG="" F S PSDRG=$O(^TMP("PSDACT",$J,PSDRG)) Q:PSDRG=""!(PSDOUT) S PG=0 D PAGE Q:PSDOUT D HDR Q:PSDOUT S CNT=1 W !,?5,"=> ",PSDRG F PSD=0:0 S PSD=$O(^TMP("PSDACT",$J,PSDRG,PSD)) Q:'PSD!(PSDOUT) D
- .F TYP=0:0 S TYP=$O(^TMP("PSDACT",$J,PSDRG,PSD,TYP)) Q:'TYP!(PSDOUT) F PSDA=0:0 S PSDA=$O(^TMP("PSDACT",$J,PSDRG,PSD,TYP,PSDA)) Q:'PSDA!(PSDOUT) S NODE=^TMP("PSDACT",$J,PSDRG,PSD,TYP,PSDA) D
- ..W:CNT ?115,$P(NODE,"^"),!! S CNT=0,FLAG=1
- ..I $Y+4>IOSL D HDR Q:PSDOUT W !,?5,"=> ",PSDRG,?115,$P(NODE,"^")
- ..S Y=PSD X ^DD("DD") S DATE=Y
- ..;Dave B (PSD*3*30) Include Returned to stock indicator.
- ..W !,DATE,?22,$P(NODE,"^",2),?45,$P(NODE,"^",3),?95,$J($P(NODE,"^",4),6) W:$P(NODE,"^",6)=1 " (RTS)" W ?115,$P(NODE,"^")+$P(NODE,"^",4),?128,$P(NODE,"^",5)
- DONE I $E(IOST)'="C" W @IOF
- I $E(IOST,1,2)="C-",'PSDOUT W ! K DIR,DIRUT S DIR(0)="EA",DIR("A")="END OF REPORT! Press <RET> to return to the menu" D ^DIR K DIR
- END ;
- D KVAR^VADPT
- K %,%DT,%H,%I,%ZIS,ACT,ALL,BFWD,C,CNT,DA,DATE,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FLAG,LN,MFG,NAOU,NODE,NQTY,NUM
- K PAT,PG,PHARM,POP,PSD,PSDA,PSDATE,PSDED,PSDEV,PSDIO,PSDOUT,PSDPN,PSDR,PSDRG,PSDRGN,PSDS,PSDSD,PSDSN,PSDUZ,PSDUZN,RX,TEXT,TYP,QTY,TYP,TYPE,X,Y,VA("BID"),VA("PID")
- K ^TMP("PSDACT",$J),ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
- D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
- Q
- HDR ;header
- I $E(IOST,1,2)="C-",PG K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
- S PG=PG+1 W:$Y @IOF W !,?20,"Daily Activity Log for ",PSDSN,?115,"Page: ",PG,!,?20,"Date: ",$P(PSDATE,"^")," to ",$P(PSDATE,"^",2),!!
- W "DATE/TIME",?22,"NUMBER",?45,"TYPE OF ACTIVITY",?95,"QUANTITY",?115,"BALANCE",?128,"BY",!,LN,!!
- Q
- PAGE ;page stop after each drug
- I $E(IOST,1,2)="C-",FLAG W !! K DA,DIR S DIR(0)="E" D ^DIR K DIR I 'Y S PSDOUT=1 Q
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSDACT2 2046 printed Jan 18, 2025@02:46:02 Page 2
- PSDACT2 ;BIR/JPW-Print Daily Activity Log (cont'd) ; 2 Aug 94
- +1 ;;3.0; CONTROLLED SUBSTANCES ;**30**;13 Feb 97
- PRINT ;prints data
- +1 KILL LN
- SET (CNT,FLAG,PG,PSDOUT)=0
- SET $PIECE(LN,"-",132)=""
- +2 IF '$DATA(^TMP("PSDACT",$JOB))
- DO HDR
- WRITE !!,?15,"**** NO DAILY ACTIVITY ****",!!
- GOTO DONE
- +3 SET PSDRG=""
- FOR
- SET PSDRG=$ORDER(^TMP("PSDACT",$JOB,PSDRG))
- if PSDRG=""!(PSDOUT)
- QUIT
- SET PG=0
- DO PAGE
- if PSDOUT
- QUIT
- DO HDR
- if PSDOUT
- QUIT
- SET CNT=1
- WRITE !,?5,"=> ",PSDRG
- FOR PSD=0:0
- SET PSD=$ORDER(^TMP("PSDACT",$JOB,PSDRG,PSD))
- if 'PSD!(PSDOUT)
- QUIT
- Begin DoDot:1
- +4 FOR TYP=0:0
- SET TYP=$ORDER(^TMP("PSDACT",$JOB,PSDRG,PSD,TYP))
- if 'TYP!(PSDOUT)
- QUIT
- FOR PSDA=0:0
- SET PSDA=$ORDER(^TMP("PSDACT",$JOB,PSDRG,PSD,TYP,PSDA))
- if 'PSDA!(PSDOUT)
- QUIT
- SET NODE=^TMP("PSDACT",$JOB,PSDRG,PSD,TYP,PSDA)
- Begin DoDot:2
- +5 if CNT
- WRITE ?115,$PIECE(NODE,"^"),!!
- SET CNT=0
- SET FLAG=1
- +6 IF $Y+4>IOSL
- DO HDR
- if PSDOUT
- QUIT
- WRITE !,?5,"=> ",PSDRG,?115,$PIECE(NODE,"^")
- +7 SET Y=PSD
- XECUTE ^DD("DD")
- SET DATE=Y
- +8 ;Dave B (PSD*3*30) Include Returned to stock indicator.
- +9 WRITE !,DATE,?22,$PIECE(NODE,"^",2),?45,$PIECE(NODE,"^",3),?95,$JUSTIFY($PIECE(NODE,"^",4),6)
- if $PIECE(NODE,"^",6)=1
- WRITE " (RTS)"
- WRITE ?115,$PIECE(NODE,"^")+$PIECE(NODE,"^",4),?128,$PIECE(NODE,"^",5)
- End DoDot:2
- End DoDot:1
- DONE IF $EXTRACT(IOST)'="C"
- WRITE @IOF
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF 'PSDOUT
- WRITE !
- KILL DIR,DIRUT
- SET DIR(0)="EA"
- SET DIR("A")="END OF REPORT! Press <RET> to return to the menu"
- DO ^DIR
- KILL DIR
- END ;
- +1 DO KVAR^VADPT
- +2 KILL %,%DT,%H,%I,%ZIS,ACT,ALL,BFWD,C,CNT,DA,DATE,DIC,DIR,DIROUT,DIRUT,DTOUT,DUOUT,FLAG,LN,MFG,NAOU,NODE,NQTY,NUM
- +3 KILL PAT,PG,PHARM,POP,PSD,PSDA,PSDATE,PSDED,PSDEV,PSDIO,PSDOUT,PSDPN,PSDR,PSDRG,PSDRGN,PSDS,PSDSD,PSDSN,PSDUZ,PSDUZN,RX,TEXT,TYP,QTY,TYP,TYPE,X,Y,VA("BID"),VA("PID")
- +4 KILL ^TMP("PSDACT",$JOB),ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
- +5 DO ^%ZISC
- if $DATA(ZTQUEUED)
- SET ZTREQ="@"
- +6 QUIT
- HDR ;header
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF PG
- KILL DA,DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSDOUT=1
- QUIT
- +2 SET PG=PG+1
- if $Y
- WRITE @IOF
- WRITE !,?20,"Daily Activity Log for ",PSDSN,?115,"Page: ",PG,!,?20,"Date: ",$PIECE(PSDATE,"^")," to ",$PIECE(PSDATE,"^",2),!!
- +3 WRITE "DATE/TIME",?22,"NUMBER",?45,"TYPE OF ACTIVITY",?95,"QUANTITY",?115,"BALANCE",?128,"BY",!,LN,!!
- +4 QUIT
- PAGE ;page stop after each drug
- +1 IF $EXTRACT(IOST,1,2)="C-"
- IF FLAG
- WRITE !!
- KILL DA,DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- IF 'Y
- SET PSDOUT=1
- QUIT
- +2 QUIT