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

PXRRMDR1.m

Go to the documentation of this file. 
  1. PXRRMDR1 ;HERN/BDB - PCE Missing Data Report ;11 Feb 04  10:10 AM
  1.  ;;1.0;PCE PATIENT CARE ENCOUNTER;**174,168,199**;AUG 12, 1996;Build 51
  1.  ;
  1. DATASRC ; get Data Sources to print
  1.  N ID,REC
  1.  K PXDS
  1.  K DIR,DIC
  1.  S DIR(0)="Y",DIR("A")="Would you like to include ALL Data Sources"
  1.  S DIR("B")="YES" D ^DIR
  1.  I $D(DIRUT) S POP=1 Q
  1.  I Y D
  1.  . S ID="" F  S ID=$O(^PX(839.7,"B",ID)) Q:ID=""  D
  1.  . . S REC="" F  S REC=$O(^PX(839.7,"B",ID,REC)) Q:REC=""  D
  1.  . . . S PXDS(REC)=ID
  1.  . S PXDS("Unknown")=0
  1.  E  D
  1.  . S DIC=839.7,DIC(0)="QEAMZ",DIC("A")="Enter Data Source:  "
  1.  . F  D ^DIC Q:$D(DTOUT)!($D(DUOUT))!(Y=-1)  S:+Y PXDS(+Y)=""
  1.  I $D(DTOUT)!($D(DUOUT)) S POP=1
  1.  Q
  1.  ;
  1. PRINT ; Print Report
  1.  N A,I,REC,TOT,TOTE,Y,SHDR
  1.  N PAT,SSN,SSND,TYP,VIN,DEFD,ENCD
  1.  K TOT,TOTE
  1.  S DEFD="TOTAL DEFECTS FOR ",ENCD="TOTAL ENCOUNTERS FOR "
  1.  S (TOT(1),TOTE(1))=0
  1.  S LOC="" F  S LOC=$O(^TMP("PXCRPW",$J,LOC)),HDR=0 Q:LOC=""!(POP)  D
  1.  . S (TOT(2),TOTE(2))=0
  1.  . S PROV="" F  S PROV=$O(^TMP("PXCRPW",$J,LOC,PROV)) Q:PROV=""!(POP)  D
  1.  . . S (TOT(3),TOTE(3))=0
  1.  . . S SORT="" F  S SORT=$O(^TMP("PXCRPW",$J,LOC,PROV,SORT)) Q:SORT=""!(POP)  D
  1.  . . . S (TOT(4),TOTE(4))=0
  1.  . . . S VDT="" F  S VDT=$O(^TMP("PXCRPW",$J,LOC,PROV,SORT,VDT)) Q:VDT=""!(POP)  D
  1.  . . . . S (TOT(5),TOTE(5))=0
  1.  . . . . S VIN="" F  S VIN=$O(^TMP("PXCRPW",$J,LOC,PROV,SORT,VDT,VIN)),HDR1=0 Q:VIN=""!(POP)  D
  1.  . . . . . S TOT(6)=0
  1.  . . . . . S TOTE(5)=TOTE(5)+1
  1.  . . . . . S PR="" F  S PR=$O(^TMP("PXCRPW",$J,LOC,PROV,SORT,VDT,VIN,PR)) Q:PR=""  D
  1.  . . . . . . S SHDR=0
  1.  . . . . . . S SDX="" F  S SDX=$O(^TMP("PXCRPW",$J,LOC,PROV,SORT,VDT,VIN,PR,SDX)) Q:SDX=""!(POP)  D
  1.  . . . . . . . S REC=^TMP("PXCRPW",$J,LOC,PROV,SORT,VDT,VIN,PR,SDX)
  1.  . . . . . . . S PAT=$$GET1^DIQ(9000010,REC_",",.05)
  1.  . . . . . . . S SSN=$$GET1^DIQ(2,$$GET1^DIQ(9000010,REC_",",.05,"I"),.09)
  1.  . . . . . . . S SSND=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
  1.  . . . . . . . S EDT=$$GET1^DIQ(9000010,REC_",",.01)
  1.  . . . . . . . S TYP=$$GET1^DIQ(9000010,REC_",",15001)
  1.  . . . . . . . S USR=$$GET1^DIQ(9000010,REC_",",.23)
  1.  . . . . . . . D:HDR=0 HEADER Q:POP
  1.  . . . . . . . I RPTYP="D" D
  1.  . . . . . . . . I HDR1=0 D
  1.  . . . . . . . . . W ! S $P(HLINE,"-",132)="" W HLINE
  1.  . . . . . . . . . W !,$E(PAT,1,25),?26,SSND,?39,EDT,?59,$E(TYP,1,15),?75,$E(USR,1,15) S HDR1=1
  1.  . . . . . . . . W ?94,$E(SDX,1,37),!
  1.  . . . . . . . S TOT(6)=TOT(6)+1
  1.  . . . . . . . I $Y>(IOSL-4) S HDR=0
  1.  . . . . . . Q:POP
  1.  . . . . . Q:POP
  1.  . . . . . I $Y>(IOSL-4) D HEADER Q:POP
  1.  . . . . . S SHDR=1
  1.  . . . . . W:RPTYP="D" !?94,DEFD_TYP_":  ",TOT(6),!
  1.  . . . . . S TOT(5)=TOT(5)+TOT(6)
  1.  . . . . Q:POP
  1.  . . . . W !?6,DEFD_VDT_":  ",TOT(5)
  1.  . . . . W !?6,ENCD_VDT_":  ",TOTE(5)
  1.  . . . . S TOT(4)=TOT(4)+TOT(5)
  1.  . . . . S TOTE(4)=TOTE(4)+TOTE(5)
  1.  . . . Q:POP
  1.  . . . W !?4,DEFD_"SORT VALUE - "_$P(SORT,"_",1)_": ",TOT(4)
  1.  . . . W !?4,ENCD_"SORT VALUE - "_$P(SORT,"_",1)_": ",TOTE(4)
  1.  . . . S TOT(3)=TOT(3)+TOT(4)
  1.  . . . S TOTE(3)=TOTE(3)+TOTE(4)
  1.  . . Q:POP
  1.  . . W !?2,DEFD_PROV_": ",TOT(3)
  1.  . . W !?2,ENCD_PROV_": ",TOTE(3)
  1.  . . S TOT(2)=TOT(2)+TOT(3)
  1.  . . S TOTE(2)=TOTE(2)+TOTE(3)
  1.  . Q:POP
  1.  . W !,DEFD_LOC_":  ",TOT(2)
  1.  . W !,ENCD_LOC_": ",TOTE(2)
  1.  . S TOT(1)=TOT(1)+TOT(2)
  1.  . S TOTE(1)=TOTE(1)+TOTE(2)
  1.  Q:POP
  1.  I TOT(1)+TOTE(1)=0 W !!,"No Data to print",! Q
  1.  W !!,"GRAND TOTAL NUMBER OF DEFECTS:  ",TOT(1)
  1.  W !,"GRAND TOTAL NUMBER OF ENCOUNTERS = ",TOTE(1)
  1.  Q
  1.  ;
  1.  N %,X,Y,MSG,HLINE,DLINE
  1.  I (PXPAGE>0)&(($E(IOST)="C")&(IO=IO(0))) D
  1.  . S DIR(0)="E"
  1.  . W !
  1.  . D ^DIR K DIR
  1.  I $D(DUOUT)!($D(DTOUT)) D  Q
  1.  . S POP=1
  1.  I PXPAGE>0 W:$D(IOF) @IOF
  1.  S PXPAGE=PXPAGE+1
  1.  W !
  1.  S X=$$CTR132("PCE MISSING DATA REPORT") W !
  1.  D NOW^%DTC S Y=% X ^DD("DD") S X=$$CTR(Y) W !
  1.  S X=$$CTR132("By Clinic, Provider, and Date") W !
  1.  S Y=PX("BDT") X ^DD("DD") S STDT=$P(Y,"@",1)
  1.  S Y=PX("EDT") X ^DD("DD") S ENDT=$P(Y,"@",1)
  1.  S MSG=STDT_" through "_ENDT
  1.  S X=$$CTR(MSG) W !
  1.  S X=$$CTR132("Page "_PXPAGE) W !
  1.  W !!,"Patient",?26,"SSN",?39,"Date/Time",?59,"Enc. ID",?75,"Created by User",?94,"Defect",!
  1.  S $P(HLINE,"=",132)="" W HLINE,!
  1.  Q:SHDR
  1.  W !,LOC
  1.  W !?2,PROV
  1.  N SORTD S SORTD=$P(SORT,"_",1)
  1.  S:SORTD=" " SORTD="Unknown"
  1.  N SORTHDR2 S SORTHDR2=$P(SORTHDR,U,PXSRT)
  1.  I SORTHDR2="DIAGNOSIS" S SORTHDR2=$S($P(SORT,"_",2)="30":"ICD10",1:"ICD9")
  1.  W !?4,"SORT VALUE:  ",SORTHDR2,"= ",SORTD
  1.  S:VDT="" VDT="Unknown"
  1.  W !?6,$P(VDT,"@",1),":"
  1.  S HDR=1
  1.  Q
  1.  ;
  1. CTR(X) ;
  1.  W ?(IOM-$L(X))\2,X
  1.  Q 1
  1.  ;
  1. CTR132(X) ;
  1.  W ?(132-$L(X))\2,X
  1.  Q 1
  1.  ;