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

AQAOCHK4.m

Go to the documentation of this file. 
  1. AQAOCHK4 ; IHS/ORDC/LJF - PRINT TICKLER REPORT ;
  1.  ;;1.01;QAI MANAGEMENT;;OCT 05, 1995
  1.  ;
  1.  ;This rtn is called by ^AQAOCHK2 to print each occurrence with its
  1.  ;case ID, patient, indicator, ward/service and more.
  1.  ;PATCH 4: rewrote routine
  1.  ;
  1. PRINT ;ENTRY POINT >>> print selected range of items
  1.  ;called by AQAOCHK2
  1.  D INIT^AQAOUTIL
  1.  S AQAOHCON="Patient",AQAOTY="OCCURRENCE TICKLER REPORT"
  1.  D HEADING^AQAOUTIL D HDG1
  1.  ;
  1.  F AQAOI=1:1 S AQAOX=$P(AQAOXYZ(4),",",AQAOI) Q:'AQAOX  Q:AQAOSTOP=U  D
  1.  .I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U  D HDG1
  1.  .W !!,$P($T(MSG+AQAOX),";;",3),":" ;print section heading
  1.  .D LOOP
  1.  ;
  1.  I '($D(AQAOXYZ)#2) D MAP
  1.  I '$D(ZTQUEUED),IOST["C-" D PRTOPT^AQAOVAR
  1.  D END
  1.  Q
  1.  ;
  1.  ;
  1. LOOP ; -- SUBRTN to loop thru ^TMP to find cases to display
  1.  NEW AQAOIND,AQAODT,AQAOIFN
  1.  S AQAOIND=0
  1.  F  S AQAOIND=$O(^TMP("AQAOCHK",$J,AQAOX,AQAOIND)) Q:AQAOIND=""  Q:AQAOSTOP=U  D
  1.  .S AQAODT=0
  1.  .F  S AQAODT=$O(^TMP("AQAOCHK",$J,AQAOX,AQAOIND,AQAODT)) Q:AQAODT=""  Q:AQAOSTOP=U  D
  1.  ..S AQAOIFN=0
  1.  ..F  S AQAOIFN=$O(^TMP("AQAOCHK",$J,AQAOX,AQAOIND,AQAODT,AQAOIFN)) Q:AQAOIFN=""  Q:AQAOSTOP=U  D
  1.  ...I $D(AQAOXYZ)#2,((AQAOX=2)!(AQAOX=3)) D ALLREF Q  ;prt all referrals
  1.  ...S AQAOSTR=$G(^TMP("AQAOCHK",$J,AQAOX,AQAOIND,AQAODT,AQAOIFN)) ;PATCH 3
  1.  ...I AQAOX=5 D PRINTA Q  ;action plan item
  1.  ...Q:AQAOSTR=""  ;PATCH 3
  1.  ...D OCCPRNT
  1.  Q
  1.  ;
  1. OCCPRNT ; -- SUBRTN to print out cases
  1.  I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U  D HDG1
  1.  W !,"#",$P(^AQAOC(+AQAOIFN,0),U) ;case id #
  1.  I AQAOX<4 W $$OVERDUE^AQAOCHK0 ;print * if overdue for review
  1.  S Y=AQAODT X ^DD("DD") W ?10,Y ;occ or review date
  1.  S X=$P(^AQAOC(+AQAOIFN,0),U,2)
  1.  W:X]"" ?23,$J($P(^AUPNPAT(X,41,DUZ(2),0),U,2),6) ;chart #
  1.  W ?32,$P(^AQAO(2,AQAOIND,0),U) ;indicator #
  1.  ;
  1.  I AQAOX=1 D  Q  ;no other print items for initial reviews
  1.  .W:$P(^AQAOC(+AQAOIFN,0),U,11)=1 ?43,"AUTOMATED ENTRY" W ?60
  1.  .S X=$P(^AQAOC(+AQAOIFN,0),U,6) I X]"" W $P($G(^SC(X,0)),U,2),"/"
  1.  .S X=$P(^AQAOC(+AQAOIFN,0),U,7) I X]"" W $P($G(^DIC(49,X,0)),U,2)
  1.  ;
  1.  I AQAOX=4 D  Q  ;reviewed, not closed occ
  1.  .W ?43,"Last review: ",$E($P(^AQAO(7,$P(AQAOSTR,U,2),0),U),1,4)
  1.  .S X=$P(AQAOSTR,U,3) W:X]"" ?62,"Action: ",$P(^AQAO(6,X,0),U,2)
  1.  ;
  1.  ;print referred by for aqax=2 or 3
  1.  S Y=$P(AQAOSTR,U,2),C=$P(^DD(9002167,.14,0),U,2) D Y^DIQ
  1.  W ?43,"Referred by: ",$E(Y,1,23)
  1.  S Y=$P(AQAOSTR,U,3),C=$P(^DD(9002167,.19,0),U,2) D Y^DIQ
  1.  W !?43,"Referred to: ",$E(Y,1,23)
  1.  Q
  1.  ;
  1. MAP ; -- SUBRTN to print out map to find options
  1.  I $Y>(IOSL-9) D NEWPG^AQAOUTIL D HDG1
  1.  W !!,">>To find Occurrence Data Entry options, follow this path:"
  1.  W !?5,"D for Data Collection Menu;"
  1.  W !?10,"ODE for Occurrence Data Entry Menu;"
  1.  W !?15,"And then POW for Print Occurrence Worksheets;"
  1.  W !?21,"Or OCC for Enter/Edit Occurrence Record;"
  1.  W !?21,"Or PRW for Print Review Worksheets;"
  1.  W !?21,"Or REV for Enter/Edit Occurrence Review."
  1.  Q
  1.  ;
  1.  ;
  1. END ;ENTRY POINT called by AQAOCHK1
  1.  K ^TMP("AQAOCHK",$J) K AQAOXYZ,AQAOALL,AQAOR1,AQAOR2
  1.  D ^%ZISC D KILL^AQAOUTIL
  1.  Q
  1.  ;
  1.  ;
  1. ALLREF ; >> SUBRTN to print all referrals for qi staff user
  1.  NEW AQAON1,AQAON2
  1.  S AQAON1=-1
  1.  F  S AQAON1=$O(^TMP("AQAOCHK",$J,AQAOX,AQAOIND,AQAODT,AQAOIFN,AQAON1)) Q:AQAON1=""  Q:AQAOSTOP=U  D
  1.  . S AQAON2=-1
  1.  . F  S AQAON2=$O(^TMP("AQAOCHK",$J,AQAOX,AQAOIND,AQAODT,AQAOIFN,AQAON1,AQAON2)) Q:AQAON2=""  Q:AQAOSTOP=U  D
  1.  .. S AQAOSTR=^TMP("AQAOCHK",$J,AQAOX,AQAOIND,AQAODT,AQAOIFN,AQAON1,AQAON2)
  1.  .. I AQAOX=2,'$D(AQAOALL),+$P(AQAOSTR,U,3)'=DUZ Q  ;only your refrls
  1.  .. I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U  D HDG1
  1.  .. W !,"#",$P(^AQAOC(+AQAOIFN,0),U) ;case id #
  1.  .. I AQAOX<4 W $$OVERDUE^AQAOCHK0 ;print * if overdue for review
  1.  .. S Y=AQAODT X ^DD("DD") W ?10,Y ;occ date
  1.  .. S X=$P(^AQAOC(+AQAOIFN,0),U,2)
  1.  .. W:X]"" ?23,$J($P(^AUPNPAT(X,41,DUZ(2),0),U,2),6) ;chart #
  1.  .. W ?32,$P(^AQAO(2,AQAOIND,0),U) ;indicator #
  1.  .. S Y=$P(AQAOSTR,U,2),C=$P(^DD(9002167,.14,0),U,2) D Y^DIQ
  1.  .. W ?43,"Referred by: ",$E(Y,1,23)
  1.  .. S Y=$P(AQAOSTR,U,3),C=$P(^DD(9002167,.19,0),U,2) D Y^DIQ
  1.  .. W !?43,"Referred to: ",$E(Y,1,23)
  1.  Q
  1.  ;
  1.  ;
  1. PRINTA ; >> SUBRTN to print action plan items
  1.  I $Y>(IOSL-4) D NEWPG^AQAOUTIL Q:AQAOSTOP=U  D HDG1
  1.  W !,"#",$P(^AQAO(5,+AQAOIFN,0),U) ;action plan #
  1.  W ?12,"Indicator: ",$P(^AQAO(2,AQAOIND,0),U) ;indicator #
  1.  S Y=AQAODT,C=$P(^DD(9002168.5,.05,0),U,2) D Y^DIQ
  1.  W ?32,$E(Y,1,25) ;status
  1.  S X=$P(^AQAO(5,+AQAOIFN,0),U,2)
  1.  W:X]"" ?60,"ACTION TYPE:  ",$P(^AQAO(6,X,0),U,2) ;action type
  1.  Q
  1.  ;
  1.  ;
  1. HDG1 ; >> SUBRTN to print 2nd half of heading
  1.  W ?22,"(Occurrences & Action Plans Pending)"
  1.  W !?20,"[""*"" after Case ID means overdue for review]",!,AQAOLINE
  1.  W !,"Case ID",?10,"Occ/Rev Dt",?23,"Chart #",?32,"Indicator"
  1.  W ?43,"Comments",!,AQAOLIN2,!
  1.  Q
  1.  ;
  1.  ;
  1. MSG ;;
  1.  ;; Occurrence(s) needing INITIAL REVIEWS;;INITIAL REVIEWS
  1.  ;; Occurrence(s) with PERSONAL REFERRALS;;PERSONAL REFERRALS
  1.  ;; Occurrence(s) with REFERRALS TO QI TEAM;;TEAM REFERRALS
  1.  ;; Occurrence(s) REVIEWED but NOT CLOSED;;OPEN OCCURRENCES
  1.  ;; Pending ACTION PLAN(S);;ACTION PLANS