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

ADGICPP.m

Go to the documentation of this file. 
  1. ADGICPP ; IHS/ADC/PDW/ENM - CHART DEFICIENCY LIST ; [ 03/25/1999  11:48 AM ]
  1.  ;;5.0;ADMISSION/DISCHARGE/TRANSFER;;MAR 25, 1999
  1.  ;
  1. A ;--main
  1.  U IO D INI F DGII=1:1:DGNUM D LPRV Q:DGSTOP=U
  1.  I DGSTOP=U D END1 Q
  1.  I DGSUMPG=2!(DGSUMPG=3) D
  1.  . I DGPAGE>0,(IOST["C-") K DIR S DIR(0)="E" D ^DIR Q:X=U
  1.  . D ^ADGICPP1          ;summary page
  1.  I DGSTOP=U D END1 Q
  1.  D END Q
  1.  ;
  1. INI ;--initialize variables
  1.  S DGSTOP="",DGFLG=0,DGPAGE=0,$P(DGLIN,"=",80)=""
  1.  S DGDUZ=$P(^VA(200,DUZ,0),U,2) S DGFAC=$P(^DIC(4,DUZ(2),0),U)
  1.  K ^TMP("DGZICPL1",$J)   ;summary page counts
  1.  Q
  1.  ;
  1. END ;--cleanup
  1.  I IOST?1"C-".E D PRTOPT^ADGVAR
  1. END1 D KILL^ADGUTIL,^%ZISC
  1.  K ^TMP("DGZICPL",$J),^TMP("DGZICPL1",$J)
  1.  Q
  1.  ;
  1. LPRV ;--loop provider
  1.  N PR
  1.  S PR="" F  S PR=$O(^TMP("DGZICPL",$J,PR)) Q:PR=""!(DGSTOP=U)  D
  1.  . D PINI,NEWPG,LUTL Q:DGSTOP=U
  1.  . D:DGSUMPG=1!(DGSUMPG=3) TOTALS D SUM
  1.  Q
  1.  ;
  1. PINI ;--provider name and zero counts
  1.  S DGPRVN=PR,DGTCNT=0
  1.  F DGI="SIG","ISG","SUM","ASH","OPR","DEL" S DGCNT(DGI)=0
  1.  Q
  1.  ;
  1. LUTL ;--loop disch date, patient name, dfn
  1.  N SD,NM,DFN
  1.  S SD=0 F  S SD=$O(^TMP("DGZICPL",$J,PR,SD)) Q:'SD!(DGSTOP=U)  D
  1.  . S NM=""
  1.  . F  S NM=$O(^TMP("DGZICPL",$J,PR,SD,NM)) Q:NM=""!(DGSTOP=U)  D
  1.  .. S DFN=0
  1.  .. F  S DFN=$O(^TMP("DGZICPL",$J,PR,SD,NM,DFN)) Q:'DFN!(DGSTOP=U)  D 1
  1.  Q
  1.  ;
  1. 1 ;--incomplete chart file data
  1.  N N,CHT,SUM,OP,J
  1.  S N=^TMP("DGZICPL",$J,PR,SD,NM,DFN)
  1.  S CHT=$P(N,U),SUM=$P(N,U,2),OP=$P(N,U,3)
  1.  ;--total incomplete charts for provider
  1.  S DGTCNT=DGTCNT+1,^TMP("DGZICPL1",$J,"Z",DFN)=""
  1.  ;--write patient line
  1.  I DGSUMPG'=2 D  Q:DGSTOP=U
  1.  . I $Y>(IOSL-6) D NEWPG Q:DGSTOP=U
  1.  . W !!,$E(NM,1,20),?22,$J(CHT,6)
  1.  . W ?30,$E(SD,4,5)_"/"_$E(SD,6,7)_"/"_$E(SD,2,3)
  1.  . W:SUM'="" ?40,$E(SUM,4,5)_"/"_$E(SUM,6,7)_"/"_$E(SUM,2,3)
  1.  . W:OP'="" ?50,$E(OP,4,5)_"/"_$E(OP,6,7)_"/"_$E(OP,2,3)
  1.  ;--loop deficiencies
  1.  F J=4:1 Q:'$P(N,U,J)  D CHDEF
  1.  ;--loop delinquencies ("isg" 'del sig) 
  1.  S J="" F  S J=$O(DGA(J)) Q:J=""  S DGCNT(J)=DGCNT(J)+1
  1.  K DGA S DGFLG=0
  1.  Q
  1.  ;
  1. CHDEF ;--chart deficiencies 
  1.  N CD,GRP
  1.  S DGX=^ADGCD($P(N,U,J),0),CD=$P(DGX,U),GRP=$P(DGX,U,3)
  1.  I GRP="" W:DGSUMPG'=2 ?59,CD,! Q
  1.  ;--deficient for signature
  1.  I GRP="SIG",(SD>DGDEL) S DGA("ISG")=1,GRP="" W:DGSUMPG'=2 ?59,CD,! Q
  1.  ;--not delinquent (a sheet excluded)
  1.  ;I SD>DGDEL,(GRP'="ASH") S GRP="" W:DGSUMPG'=2 ?59,CD,! Q
  1.  I SD>DGDEL S GRP="" W:DGSUMPG'=2 ?59,CD,! Q
  1.  ;--delinquent charts
  1.  S DGA(GRP)=1
  1.  I DGFLG'=DFN D
  1.  . S DGCNT("DEL")=DGCNT("DEL")+1,DGFLG=DFN
  1.  . S ^TMP("DGZICPL1",$J,"ZZ",DFN)=""
  1.  W:DGSUMPG'=2 ?59,$S(GRP="":" ",1:"*"),CD,$S(GRP="":" ",1:"*"),!
  1.  Q
  1.  ;
  1. TOTALS ;--print totals for each provider
  1.  ;--incomplete
  1.  I $Y>(IOSL-9) D NEWPG Q:DGSTOP=U
  1.  W !!?20,"TOTAL INCOMPLETE CHARTS: ",$J(DGTCNT,3)
  1.  I DGCNT("ISG") D
  1.  . W !?17,"# Incomplete for SIGNATURE: ",$J(DGCNT("ISG"),3)
  1.  ;--delinquent
  1.  W !!?20,"TOTAL DELINQUENT CHARTS: ",$J(DGCNT("DEL"),3)
  1.  I DGCNT("OPR") D
  1.  . W !?17,"# Delinquent for OP REPORT: ",$J(DGCNT("OPR"),3)
  1.  I DGCNT("ASH") D
  1.  . W !?19,"# Delinquent for A SHEET: ",$J(DGCNT("ASH"),3)
  1.  I DGCNT("SUM") D
  1.  . W !?19,"# Delinquent for SUMMARY: ",$J(DGCNT("SUM"),3)
  1.  I DGCNT("SIG") D
  1.  . W !?17,"# Delinquent for SIGNATURE: ",$J(DGCNT("SIG"),3)
  1.  Q
  1.  ;
  1. SUM ;--set ^TMP for summary page
  1.  S ^TMP("DGZICPL1",$J,DGPRVN)=DGTCNT_U_DGCNT("ISG")_U_DGCNT("DEL")_U_DGCNT("OPR")_U_DGCNT("ASH")_U_DGCNT("SUM")_U_DGCNT("SIG")
  1.  Q
  1.  ;
  1.  Q:DGSUMPG=2
  1.  I DGPAGE>0!(IOST["C-") W @IOF
  1.  W ?12,"*****Confidential Patient Data Covered by Privacy Act*****"
  1.  W !?80-$L(DGFAC)/2,DGFAC,!,DGDUZ
  1.  W ?27,"INCOMPLETE CHART LIST FOR"
  1.  W !,$E(DT,4,5)_"/"_$E(DT,6,7)_"/"_$E(DT,2,3)
  1.  W ?80-$L(DGPRVN)/2,DGPRVN
  1.  S DGPAGE=DGPAGE+1 W ?65,"Page ",DGPAGE
  1.  W !!,"Patient Name",?22,"HRCN",?30,"Dsch Date",?40,"Summ Dict"
  1.  W ?50,"Op Dict",?60,"Chart Deficiency",!,DGLIN
  1.  Q
  1.  ;
  1. NEWPG ;--page control
  1.  Q:DGSUMPG=2
  1.  ;--printer
  1.  I DGPAGE=0!(IOST'?1"C-".E) D HEAD Q
  1.  ;--terminal
  1.  K DIR S DIR(0)="E" D ^DIR S DGSTOP=X
  1.  Q:X=U  D HEAD Q