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

AQAOPR72.m

Go to the documentation of this file. 
  1. AQAOPR72 ; IHS/ORDC/LJF - PRINT REVIEWED OCC RPRT ;
  1.  ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
  1.  ;
  1.  ;This rtn prints the occurrences by indicator listing all reviews
  1.  ;performed and who performed them.
  1.  ;
  1. INIT ; >>> initialize variables
  1.  D INIT^AQAOUTIL S AQAOHCON="Patient"
  1.  S AQAOTY="REVIEWED OCCURRENCES REPORT"
  1.  S AQAORG=$E(AQAOBD,4,5)_"/"_$E(AQAOBD,6,7)_"/"_$E(AQAOBD,2,3)_" to "
  1.  S AQAORG=AQAORG_$E(AQAOED,4,5)_"/"_$E(AQAOED,6,7)_"/"_$E(AQAOED,2,3)
  1.  S AQAONOT=0 ;counter for occ not reviewed
  1.  K ^TMP("AQAO",$J)
  1.  ;
  1. MAIN ; >>> main calls
  1.  I '$D(^TMP("AQAOPR7A",$J)) D 
  1.  .D HEADING^AQAOUTIL,HDG1
  1.  .W !!,"NO DATA FOUND FOR DATE RANGE SPECIFIED",!!
  1.  E  D LISTING I AQAOSTOP'=U D SUMMARY^AQAOPR73
  1.  ;
  1. END ; >>> eoj
  1.  D ^%ZISC I '$D(ZTQUEUED) D PRTOPT^AQAOVAR
  1.  K ^TMP("AQAOPR7",$J),^TMP("AQAOPR7A",$J),^TMP("AQAO",$J)
  1.  K AQAOINAC D KILL^AQAOUTIL Q
  1.  ;
  1.  ;
  1. LISTING ; >> SUBRTN to print occurrence listing if selected
  1.  D HEADING^AQAOUTIL,HDG1
  1.  ;
  1.  S AQAOIND=0 ;loop by indicator and print occurrences
  1.  F  S AQAOIND=$O(^TMP("AQAOPR7A",$J,AQAOIND)) Q:AQAOIND=""  Q:AQAOSTOP=U  D
  1.  .D LIST2 Q:AQAOSTOP=U  ;list each occ with reviews
  1.  Q
  1.  ;
  1.  ;
  1. LIST2 ; >> SUBRTN for each AQAOIND list occ with reviews
  1.  I AQAOIND'=0 W !!?AQAOIOMX-$L(AQAOIND)/2,AQAOIND,!
  1.  S AQAODT=0
  1.  F  S AQAODT=$O(^TMP("AQAOPR7A",$J,AQAOIND,AQAODT)) Q:AQAODT=""  Q:AQAOSTOP=U  D
  1.  .S AQAON=0
  1.  .F  S AQAON=$O(^TMP("AQAOPR7A",$J,AQAOIND,AQAODT,AQAON)) Q:AQAON=""  Q:AQAOSTOP=U  D
  1.  ..S AQAOSTR=$G(^AQAOC(AQAON,0)),AQAOSTR1=$G(^(1)) ;basic occ data
  1.  ..I $Y>(IOSL-2) D NEWPG^AQAOUTIL Q:AQAOSTOP=U  D HDG1
  1.  ..S Y=AQAODT X ^DD("DD") W !,$P(AQAOSTR,U),?9,Y ;print case & date
  1.  ..K ^UTILITY("DIQ1",$J) S DIC="^AQAOC(",DA=AQAON,DR=".025" D EN^DIQ1
  1.  ..W ?22,$S(+AQAOSTR1=0:"OPEN",+AQAOSTR1=1:"CLOSED",1:"DELETED") ;status
  1.  ..;
  1.  ..D FINDING
  1.  Q
  1.  ;
  1.  ;
  1. FINDING ; >> SUBRTN to find findings,etc. for occ
  1.  ;get initial finding and action
  1.  S AQAOW=$P($G(^AQAOC(AQAON,1)),U,8) ;review date
  1.  S AQAOX=$P($G(^AQAOC(AQAON,1)),U,5) ;finding
  1.  S AQAOY=$P($G(^AQAOC(AQAON,1)),U,4) ;reviewer
  1.  S AQAOZ=$P($G(^AQAOC(AQAON,1)),U,6) ;action
  1.  S X=$P($G(^AQAOC(AQAON,1)),U,9) ;referred to;PATCH 3
  1.  I X]"" S AQAOAR(1)=X,X=1,Y=0 F  S Y=$O(^AQAOC(AQAON,"IADDRV",Y)) Q:Y'=+Y  D  ;PATCH 3
  1.  .S X=X+1,AQAOAR(X)=$P($G(^AQAOC(AQAON,"IADDRV",Y,0)),U) ;addl referrals
  1.  I AQAOW="" S AQAONOT=AQAONOT+1 Q  ;occ not reviewed
  1.  W !?22,"Reviews:"
  1.  D PRINTREV K AQAOAR
  1.  ;
  1.  S AQAOR=0 F  S AQAOR=$O(^AQAOC(AQAON,"REV",AQAOR)) Q:AQAOR'=+AQAOR  D
  1.  .S AQAOW=$P(^AQAOC(AQAON,"REV",AQAOR,0),U,4) ;review date
  1.  .S AQAOX=$P(^AQAOC(AQAON,"REV",AQAOR,0),U,5) ;finding
  1.  .S AQAOY=$P(^AQAOC(AQAON,"REV",AQAOR,0),U,2) ;reviewer
  1.  .S AQAOZ=$P(^AQAOC(AQAON,"REV",AQAOR,0),U,7) ;action
  1.  .S (X,Y)=0 F  S Y=$O(^AQAOC(AQAON,"REV",AQAOR,"ADDRV",Y)) Q:Y'=+Y  D
  1.  ..S X=X+1,AQAOAR(X)=$P($G(^AQAOC(AQAON,"REV",AQAOR,"ADDRV",Y,0)),U)
  1.  .D PRINTREV K AQAOAR
  1.  ;
  1.  I $P(^AQAOC(AQAON,1),U)=1 D  ;closed occurrences
  1.  .S AQAOW=$P($G(^AQAOC(AQAON,"FINAL")),U) ;review date
  1.  .S AQAOX=$P($G(^AQAOC(AQAON,"FINAL")),U,4) ;finding
  1.  .S AQAOY=$P($G(^AQAOC(AQAON,"FINAL")),U,5)_";VA(200," ;reviewer
  1.  .S AQAOZ=$P($G(^AQAOC(AQAON,"FINAL")),U,6) ;action
  1.  .D PRINTREV
  1.  Q
  1.  ;
  1.  ;
  1. PRINTREV ; SUBRTN to print rev date,reviewer,finding,action
  1.  Q:AQAOW=""
  1.  S Y=AQAOW,C=$P(^DD(9002167,.18,0),U,2) D Y^DIQ W ?32,Y ;review date
  1.  S Y=AQAOY,C=$P(^DD(9002167,.14,0),U,2) D Y^DIQ ;reviewer
  1.  W ?47,$$NAME
  1.  I Y]"" S ^TMP("AQAO",$J,Y,AQAOIND,AQAON)=""
  1.  S Y=$S(AQAOX="":"",1:$P($G(^AQAO(8,AQAOX,0)),U,2)) W ?62,Y ;finding
  1.  S Y=$S(AQAOZ="":"",1:$P($G(^AQAO(6,AQAOZ,0)),U,2)) W ?72,Y ;action
  1.  I $D(AQAOAR) S AQAOX=0 F  S AQAOX=$O(AQAOAR(AQAOX)) Q:AQAOX=""  D
  1.  .W:AQAOX=1 !?47,"Referred to:" W:AQAOX>1 !
  1.  .S Y=AQAOAR(AQAOX),C=$P(^DD(9002167,.19,0),U,2) D Y^DIQ ;referrals
  1.  .W ?62,$$NAME
  1.  W ! Q
  1.  ;
  1.  ;
  1. HDG1 ; >> SUBRTN for second half of heading
  1.  W ?30,AQAORG,!,AQAOLINE
  1.  W !,"Case #",?9,"Occ Date",?22,"Status"
  1.  W ?32,"Rev Date",?47,"Revwr",?62,"Finding",?72,"Action"
  1.  W !,AQAOLINE
  1.  Q
  1.  ;
  1.  ;
  1. HDG2 ; >> SUBRTN for second half of heading2    
  1.  W ?33,"(SUMMARY PAGE)",!?30,AQAORG,!,AQAOLINE,!
  1.  Q
  1.  ;
  1.  ;
  1. NAME() ; >> EXTRN VAR for printing names
  1.  I Y'["," S Y=$E(Y,1,12) Q Y
  1.  S Y=$P(Y,",")_","_$E($P(Y,",",2),1),Y=$E(Y,1,12) Q Y