Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APSPDRP1

APSPDRP1.m

Go to the documentation of this file. 
  1. APSPDRP1 ; IHS/DSD/ENM - PRINT DUE REVIEW REPORT ;  [ 09/03/97   1:30 PM ]
  1.  ;;6.0;IHS PHARMACY MODIFICATIONS;;09/03/97
  1.  ; This routine is responsible for getting the information to
  1.  ; print and doing the formatting of the report.
  1.  ; The routine calls APSDRP2 to do the actual printing.  I had to
  1.  ; break up the routine because of its size.
  1.  ;
  1.  ; Input Variables:  APSPDRP("BD"),APSPDRP("ED"),APSPDRP("IOP"),
  1.  ;                   ^TMP("APSPDRP1",$J,
  1.  ;-----------------------------------------------------------------
  1. START ;
  1.  S (DX,DY)=1 X:$D(^%ZOSF("XY"))#2 ^("XY")
  1.  I '$D(ZTSK),$P(APSPDRP("IOP"),";",1)'=ION S IOP=APSPDRP("IOP") D ^%ZIS U IO
  1.  ELSE  U IO
  1.  D BODY
  1. END D EOJ
  1.  Q
  1.  ;------------------------------------------------------------------
  1. BODY ;
  1.  F APSPDRP1("STUDY")=0:0 S APSPDRP1("STUDY")=$O(^TMP("APSPDRP1",$J,APSPDRP1("STUDY"))) Q:'APSPDRP1("STUDY")!($D(APSPDRP1("QFLG")))  D INIT,HEADER,^APSPDRP2 D:'$D(APSPDRP1("QFLG")) TOTAL
  1.  D ^%ZISC
  1.  Q
  1. INIT ;
  1.  S APSPDRP1("STUDY CNT")=0 K APSPDRP1("STUDY CR")
  1.  F APSPI=0:0 S APSPI=$O(^APSPDUE(32.1,APSPDRP1("STUDY"),11,APSPI)) Q:'APSPI  S APSPDRP1("STUDY CR",$P(^APSPDUE(32.2,APSPI,0),U,1))="",APSPDRP1("STUDY CNT")=APSPDRP1("STUDY CNT")+1
  1.  S APSPDRP1("CR LF")=((APSPDRP1("STUDY CNT")*6)/(IOM-68))
  1.  S:APSPDRP1("CR LF")["." APSPDRP1("CR LF")=$P(APSPDRP1("CR LF"),".",1)+1
  1.  K APSPI
  1.  K APSPDRP1("YES CNT")
  1.  S (APSPDRP1("CNT"),APSPDRP1("ALL MET CNT"))=0
  1.  S APSPDRP1("PAGE")=0
  1.  Q
  1.  S APSPDRP1("PAGE")=APSPDRP1("PAGE")+1
  1.  I $D(DUZ(2)) W !!,$P(^DIC(4,DUZ(2),0),"^",1)," ",$P(^APSPDUE(32.1,APSPDRP1("STUDY"),0),U,1)," STUDY REPORT"
  1.  I '$D(DUZ(2)) W !!,$P(^APSPDUE(32.1,APSPDRP1("STUDY"),0),U,1)," STUDY REPORT"
  1.  W ?73,"Page ",APSPDRP1("PAGE")
  1.  W !,"DATE OF REPORT: "
  1.  S Y=DT X ^DD("DD") W Y K Y
  1.  W !!,"This report will include all DUE review entries "
  1.  W "from ",!
  1.  S Y=APSPDRP("BD") X ^DD("DD") W Y," through " K Y
  1.  S Y=$P(APSPDRP("ED"),".",1) X ^DD("DD") W Y,".",!!
  1.  W !,?69,"CRITERIA",?(IOM-3),"ALL"
  1.  W !,?69,"MET",?(IOM-3),"MET",!
  1.  W !,"DATE",?15,"PATIENT",?40,"PROVIDER",?62 D
  1.  . F APSPII=0:0 S APSPII=$O(APSPDRP1("STUDY CR",APSPII)) Q:'APSPII  W:$X+12>IOM !,?62 W ?($X+3),APSPII I $L(APSPII)<3 W $S($L(APSPII)<2:"  ",1:" ")
  1.  K APSPII
  1.  W ! F I=1:1:(IOM) W "_"
  1.  W !
  1.  Q
  1. TOTAL ; Prints totals from Report
  1.  I $E(IOST,1,2)="P-",($Y+6+APSPDRP1("CR LF"))>IOSL W @IOF D HEADER
  1.  I $E(IOST,1,2)'="P-",($Y+6+APSPDRP1("CR LF"))>IOSL D EOP G:$D(APSPDRP1("QFLG")) TOTALX
  1.  W !
  1.  W ! F I=1:1:(IOM) W "_"
  1.  W !
  1.  W !,"TOTAL",?62
  1.  F APSPII=0:0 S APSPII=$O(APSPDRP1("YES CNT",APSPII)) Q:'APSPII  W:$X+12>IOM !,?62 W ?($X+3),APSPDRP1("YES CNT",APSPII) I $L(APSPII)<3 W $S($L(APSPII)<2:"  ",1:" ")
  1.  W ?(IOM-3),APSPDRP1("ALL MET CNT")
  1.  W !,"COUNT",?15,APSPDRP1("CNT")
  1.  W !
  1.  I $E(IOST,1,2)="P-" W @IOF
  1. TOTALX Q
  1.  ;
  1. EOP ; Calls reader for an End of Page call
  1.  S DIR(0)="E" D ^DIR K DIR,X,Y
  1.  S:$D(DTOUT)!($D(DUOUT)) APSPDRP1("QFLG")=1
  1.  S (DX,DY)=1 X:$D(^%ZOSF("XY"))#2 ^("XY")
  1.  Q
  1. EOJ ;
  1.  K:$D(ZTSK) ZTSK ;IHS/DSD/ENM 01/14/97
  1.  K APSPDRP1,^TMP("APSPDRP1",$J),DTOUT,DUOUT,DIR,DIRUT
  1.  Q
  1.  ;