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. ;