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

AQAOPR22.m

Go to the documentation of this file. 
  1. AQAOPR22 ; IHS/ORDC/LJF - PRINT REVIEW WORKSHEET CONT. ;
  1.  ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
  1.  ;
  1.  ;This rtn prints the review worksheet which lists the possible 
  1.  ;answers for an occurrence review based on review level.
  1.  ;
  1. INIT ; >>> initialize variables    
  1.  S AQAOLINE="",$P(AQAOLINE,"=",80)=""
  1.  S AQAOLIN2="",$P(AQAOLIN2,"_",20)=""
  1.  S AQAOSTOP=""
  1.  ;
  1. HEADING ; >>> print worksheet heading & top section 
  1.  S IOP=AQAODEV D ^%ZIS U IO
  1.  W !,"REVIEW WORKSHEET FOR QAI OCCURRENCE"
  1.  S Y=DT X ^DD("DD") W ?60,Y D TIME^AQAOUTIL S AQAOSTR=^AQAOC(AQAOIFN,0)
  1.  S AQAONAM=$P($G(^DPT($P(AQAOSTR,U,2),0)),U)
  1.  W !,"Case ID:  ",AQAOCID W ?40,"Patient:  ",$E(AQAONAM,1,20)
  1.  S X=$P(AQAOSTR,U,2) W "  #",$P(^AUPNPAT(X,41,DUZ(2),0),U,2) ;chart #
  1.  W !,"Occurrence Date:  " S Y=$P(AQAOSTR,U,4) X ^DD("DD") W Y
  1.  W ?40,"Visit Date:  "
  1.  S (AQAOV,Y)=$P(AQAOSTR,U,3)
  1.  I Y]"" S Y=$P(^AUPNVSIT(Y,0),U) X ^DD("DD") W Y
  1.  I AQAOV D
  1.  .S Y=$P(^AUPNVSIT(AQAOV,0),U,7),C=$P(^DD(9000010,.07,0),U,2) D Y^DIQ
  1.  .W "(",$E(Y,1,4),")" ;visit service category
  1.  S Y=$P(AQAOSTR,U,7),C=$P(^DD(9002167,.07,0),U,2) D Y^DIQ
  1.  W !,"Service/Ward or Clinic:  ",$E(Y,1,25),"/"
  1.  S Y=$P(AQAOSTR,U,6),C=$P(^DD(9002167,.06,0),U,2) D Y^DIQ W $E(Y,1,25)
  1.  W !,"Indicator:  "
  1.  S Y=$P(AQAOSTR,U,8) I Y]"" W $P(^AQAO(2,Y,0),U),?25,$P(^(0),U,2)
  1.  W !,AQAOLINE,!
  1.  ;
  1. REVIEW ; >>> print review level data
  1.  S X="*** "_$P(AQAORLEV,U,2)_" REVIEW ***" W !?(80-$L(X))/2,X,!
  1.  W !,"REVIEWER/TEAM NAME: " W AQAOLIN2,?47,"REVIEW DATE: ",AQAOLIN2
  1.  ;
  1.  ;
  1. RISK ; >>> print all risk of outcomes in file
  1.  G COMMENT:(+AQAORLEV=1) ;no outcome levels at non-clin review level
  1.  F AQAOI=2,4,5 D  Q:AQAOSTOP=U
  1.  .W !!,$S(AQAOI=2:"POTENTIAL OF ADVERSE OUTCOME:",AQAOI=4:"ADVERSE OUTCOME OF OCCURRENCE:",1:"ULTIMATE PATIENT OUTCOME (Only asked when closing occurrence)"),!
  1.  .S AQAOX=0 F  S AQAOX=$O(^AQAO1(3,AQAOX)) Q:AQAOX'=+AQAOX  Q:AQAOSTOP=U  D
  1.  ..Q:'$D(^AQAO1(3,AQAOX,0))  S AQAOX1=^(0)
  1.  ..Q:$P(AQAOX1,U,3)="I"  Q:$P(AQAOX1,U,AQAOI)=""  ;inactive/othr scale
  1.  ..W !?5,"_____  ",$P(AQAOX1,U),"  ",$P(AQAOX1,U,AQAOI)
  1.  ..I $Y>(IOSL-4) D NEWPG
  1.  G END:AQAOSTOP=U
  1.  ;
  1.  ;preformance levels by provider
  1.  W !!,"PERFORMANCE LEVELS BY PROVIDER (Only asked when closing occurrence)",!
  1.  S AQAOX=0 F  S AQAOX=$O(^AQAO1(3,AQAOX)) Q:AQAOX'=+AQAOX  Q:AQAOSTOP=U  D
  1.  .Q:'$D(^AQAO1(3,AQAOX,0))  S AQAOX1=^(0)
  1.  .Q:$P(AQAOX1,U,3)="I"  Q:$P(AQAOX1,U,6)=""  ;inactive/othr scale
  1.  .W !?5,$P(AQAOX1,U),"  ",$P(AQAOX1,U,6)
  1.  .I $Y>(IOSL-4) D NEWPG
  1.  G END:AQAOSTOP=U
  1.  F I=1:1:4 D
  1.  .I $Y>(IOSL-4) D NEWPG
  1.  .W !,"PROVIDER: _______  LEVEL: _____",!
  1.  G END:AQAOSTOP=U
  1.  ;
  1. FIND ; >>> print findings available for this review level
  1.  W !!,"FINDING:",!
  1.  S AQAOX=0 F  S AQAOX=$O(^AQAO(8,AQAOX)) Q:AQAOX'=+AQAOX  Q:AQAOSTOP=U  D
  1.  .Q:'$D(^AQAO(8,AQAOX,0))  S AQAOX1=^(0) Q:$P(AQAOX1,U,4)="I"  ;inactiv
  1.  .Q:$P(AQAOX1,U,3)'[+AQAORLEV  ;not for this review level
  1.  .W !?5,"_____  ",$P(AQAOX1,U,2),?20,$P(AQAOX1,U)
  1.  .I $Y>(IOSL-4) D NEWPG
  1.  G END:AQAOSTOP=U
  1.  ;
  1. ACTION ; >>> print actions available for this review level
  1.  W !!,"ACTION:",!
  1.  S AQAOX=0 F  S AQAOX=$O(^AQAO(6,AQAOX)) Q:AQAOX'=+AQAOX  Q:AQAOSTOP=U  D
  1.  .Q:'$D(^AQAO(6,AQAOX,0))  S AQAOX1=^(0) Q:$P(AQAOX1,U,5)="I"  ;inactiv
  1.  .Q:$P(AQAOX1,U,3)'[+AQAORLEV  ;not for this review level
  1.  .W !?5,"_____  ",$P(AQAOX1,U,2),?20,$P(AQAOX1,U)
  1.  .I $Y>(IOSL-4) D NEWPG
  1.  G END:AQAOSTOP=U
  1.  ;         
  1. COMMENT ; >>> print comments area
  1.  I $Y>(IOSL-4) D NEWPG G END:AQAOSTOP=U
  1.  W !,"COMMENTS:  "
  1.  ;
  1. END ; >>> eoj
  1.  I '$D(ZTQUEUED),'$D(AQAOSLV) D PRTOPT^AQAOVAR
  1.  D ^%ZISC Q
  1.  ;
  1.  ;
  1. NEWPG ; >>> SUBRTN for end of page control
  1.  I IOST?1"C-".E K DIR S DIR(0)="E" D ^DIR S AQAOSTOP=X
  1.  I AQAOSTOP=U Q
  1.  W @IOF,!,"Case ID:  ",AQAOCID W ?40,"Patient:  ",$E(AQAONAM,1,20)
  1.  S X=$P(AQAOSTR,U,2) W "  #",$P(^AUPNPAT(X,41,DUZ(2),0),U,2) ;chart #
  1.  W !,AQAOLINE,!!
  1.  Q