PXRRMDR1 ;HERN/BDB - PCE Missing Data Report ;11 Feb 04 10:10 AM
;;1.0;PCE PATIENT CARE ENCOUNTER;**174,168,199**;AUG 12, 1996;Build 51
;
DATASRC ; get Data Sources to print
N ID,REC
K PXDS
K DIR,DIC
S DIR(0)="Y",DIR("A")="Would you like to include ALL Data Sources"
S DIR("B")="YES" D ^DIR
I $D(DIRUT) S POP=1 Q
I Y D
. S ID="" F S ID=$O(^PX(839.7,"B",ID)) Q:ID="" D
. . S REC="" F S REC=$O(^PX(839.7,"B",ID,REC)) Q:REC="" D
. . . S PXDS(REC)=ID
. S PXDS("Unknown")=0
E D
. S DIC=839.7,DIC(0)="QEAMZ",DIC("A")="Enter Data Source: "
. F D ^DIC Q:$D(DTOUT)!($D(DUOUT))!(Y=-1) S:+Y PXDS(+Y)=""
I $D(DTOUT)!($D(DUOUT)) S POP=1
Q
;
PRINT ; Print Report
N A,I,REC,TOT,TOTE,Y,SHDR
N PAT,SSN,SSND,TYP,VIN,DEFD,ENCD
K TOT,TOTE
S DEFD="TOTAL DEFECTS FOR ",ENCD="TOTAL ENCOUNTERS FOR "
S (TOT(1),TOTE(1))=0
S LOC="" F S LOC=$O(^TMP("PXCRPW",$J,LOC)),HDR=0 Q:LOC=""!(POP) D
. S (TOT(2),TOTE(2))=0
. S PROV="" F S PROV=$O(^TMP("PXCRPW",$J,LOC,PROV)) Q:PROV=""!(POP) D
. . S (TOT(3),TOTE(3))=0
. . S SORT="" F S SORT=$O(^TMP("PXCRPW",$J,LOC,PROV,SORT)) Q:SORT=""!(POP) D
. . . S (TOT(4),TOTE(4))=0
. . . S VDT="" F S VDT=$O(^TMP("PXCRPW",$J,LOC,PROV,SORT,VDT)) Q:VDT=""!(POP) D
. . . . S (TOT(5),TOTE(5))=0
. . . . S VIN="" F S VIN=$O(^TMP("PXCRPW",$J,LOC,PROV,SORT,VDT,VIN)),HDR1=0 Q:VIN=""!(POP) D
. . . . . S TOT(6)=0
. . . . . S TOTE(5)=TOTE(5)+1
. . . . . S PR="" F S PR=$O(^TMP("PXCRPW",$J,LOC,PROV,SORT,VDT,VIN,PR)) Q:PR="" D
. . . . . . S SHDR=0
. . . . . . S SDX="" F S SDX=$O(^TMP("PXCRPW",$J,LOC,PROV,SORT,VDT,VIN,PR,SDX)) Q:SDX=""!(POP) D
. . . . . . . S REC=^TMP("PXCRPW",$J,LOC,PROV,SORT,VDT,VIN,PR,SDX)
. . . . . . . S PAT=$$GET1^DIQ(9000010,REC_",",.05)
. . . . . . . S SSN=$$GET1^DIQ(2,$$GET1^DIQ(9000010,REC_",",.05,"I"),.09)
. . . . . . . S SSND=$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
. . . . . . . S EDT=$$GET1^DIQ(9000010,REC_",",.01)
. . . . . . . S TYP=$$GET1^DIQ(9000010,REC_",",15001)
. . . . . . . S USR=$$GET1^DIQ(9000010,REC_",",.23)
. . . . . . . D:HDR=0 HEADER Q:POP
. . . . . . . I RPTYP="D" D
. . . . . . . . I HDR1=0 D
. . . . . . . . . W ! S $P(HLINE,"-",132)="" W HLINE
. . . . . . . . . W !,$E(PAT,1,25),?26,SSND,?39,EDT,?59,$E(TYP,1,15),?75,$E(USR,1,15) S HDR1=1
. . . . . . . . W ?94,$E(SDX,1,37),!
. . . . . . . S TOT(6)=TOT(6)+1
. . . . . . . I $Y>(IOSL-4) S HDR=0
. . . . . . Q:POP
. . . . . Q:POP
. . . . . I $Y>(IOSL-4) D HEADER Q:POP
. . . . . S SHDR=1
. . . . . W:RPTYP="D" !?94,DEFD_TYP_": ",TOT(6),!
. . . . . S TOT(5)=TOT(5)+TOT(6)
. . . . Q:POP
. . . . W !?6,DEFD_VDT_": ",TOT(5)
. . . . W !?6,ENCD_VDT_": ",TOTE(5)
. . . . S TOT(4)=TOT(4)+TOT(5)
. . . . S TOTE(4)=TOTE(4)+TOTE(5)
. . . Q:POP
. . . W !?4,DEFD_"SORT VALUE - "_$P(SORT,"_",1)_": ",TOT(4)
. . . W !?4,ENCD_"SORT VALUE - "_$P(SORT,"_",1)_": ",TOTE(4)
. . . S TOT(3)=TOT(3)+TOT(4)
. . . S TOTE(3)=TOTE(3)+TOTE(4)
. . Q:POP
. . W !?2,DEFD_PROV_": ",TOT(3)
. . W !?2,ENCD_PROV_": ",TOTE(3)
. . S TOT(2)=TOT(2)+TOT(3)
. . S TOTE(2)=TOTE(2)+TOTE(3)
. Q:POP
. W !,DEFD_LOC_": ",TOT(2)
. W !,ENCD_LOC_": ",TOTE(2)
. S TOT(1)=TOT(1)+TOT(2)
. S TOTE(1)=TOTE(1)+TOTE(2)
Q:POP
I TOT(1)+TOTE(1)=0 W !!,"No Data to print",! Q
W !!,"GRAND TOTAL NUMBER OF DEFECTS: ",TOT(1)
W !,"GRAND TOTAL NUMBER OF ENCOUNTERS = ",TOTE(1)
Q
;
N %,X,Y,MSG,HLINE,DLINE
I (PXPAGE>0)&(($E(IOST)="C")&(IO=IO(0))) D
. S DIR(0)="E"
. W !
. D ^DIR K DIR
I $D(DUOUT)!($D(DTOUT)) D Q
. S POP=1
I PXPAGE>0 W:$D(IOF) @IOF
S PXPAGE=PXPAGE+1
W !
S X=$$CTR132("PCE MISSING DATA REPORT") W !
D NOW^%DTC S Y=% X ^DD("DD") S X=$$CTR(Y) W !
S X=$$CTR132("By Clinic, Provider, and Date") W !
S Y=PX("BDT") X ^DD("DD") S STDT=$P(Y,"@",1)
S Y=PX("EDT") X ^DD("DD") S ENDT=$P(Y,"@",1)
S MSG=STDT_" through "_ENDT
S X=$$CTR(MSG) W !
S X=$$CTR132("Page "_PXPAGE) W !
W !!,"Patient",?26,"SSN",?39,"Date/Time",?59,"Enc. ID",?75,"Created by User",?94,"Defect",!
S $P(HLINE,"=",132)="" W HLINE,!
Q:SHDR
W !,LOC
W !?2,PROV
N SORTD S SORTD=$P(SORT,"_",1)
S:SORTD=" " SORTD="Unknown"
N SORTHDR2 S SORTHDR2=$P(SORTHDR,U,PXSRT)
I SORTHDR2="DIAGNOSIS" S SORTHDR2=$S($P(SORT,"_",2)="30":"ICD10",1:"ICD9")
W !?4,"SORT VALUE: ",SORTHDR2,"= ",SORTD
S:VDT="" VDT="Unknown"
W !?6,$P(VDT,"@",1),":"
S HDR=1
Q
;
CTR(X) ;
W ?(IOM-$L(X))\2,X
Q 1
;
CTR132(X) ;
W ?(132-$L(X))\2,X
Q 1
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRRMDR1 4519 printed Dec 13, 2024@02:30:51 Page 2
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
+2 ;
DATASRC ; get Data Sources to print
+1 NEW ID,REC
+2 KILL PXDS
+3 KILL DIR,DIC
+4 SET DIR(0)="Y"
SET DIR("A")="Would you like to include ALL Data Sources"
+5 SET DIR("B")="YES"
DO ^DIR
+6 IF $DATA(DIRUT)
SET POP=1
QUIT
+7 IF Y
Begin DoDot:1
+8 SET ID=""
FOR
SET ID=$ORDER(^PX(839.7,"B",ID))
if ID=""
QUIT
Begin DoDot:2
+9 SET REC=""
FOR
SET REC=$ORDER(^PX(839.7,"B",ID,REC))
if REC=""
QUIT
Begin DoDot:3
+10 SET PXDS(REC)=ID
End DoDot:3
End DoDot:2
+11 SET PXDS("Unknown")=0
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 SET DIC=839.7
SET DIC(0)="QEAMZ"
SET DIC("A")="Enter Data Source: "
+14 FOR
DO ^DIC
if $DATA(DTOUT)!($DATA(DUOUT))!(Y=-1)
QUIT
if +Y
SET PXDS(+Y)=""
End DoDot:1
+15 IF $DATA(DTOUT)!($DATA(DUOUT))
SET POP=1
+16 QUIT
+17 ;
PRINT ; Print Report
+1 NEW A,I,REC,TOT,TOTE,Y,SHDR
+2 NEW PAT,SSN,SSND,TYP,VIN,DEFD,ENCD
+3 KILL TOT,TOTE
+4 SET DEFD="TOTAL DEFECTS FOR "
SET ENCD="TOTAL ENCOUNTERS FOR "
+5 SET (TOT(1),TOTE(1))=0
+6 SET LOC=""
FOR
SET LOC=$ORDER(^TMP("PXCRPW",$JOB,LOC))
SET HDR=0
if LOC=""!(POP)
QUIT
Begin DoDot:1
+7 SET (TOT(2),TOTE(2))=0
+8 SET PROV=""
FOR
SET PROV=$ORDER(^TMP("PXCRPW",$JOB,LOC,PROV))
if PROV=""!(POP)
QUIT
Begin DoDot:2
+9 SET (TOT(3),TOTE(3))=0
+10 SET SORT=""
FOR
SET SORT=$ORDER(^TMP("PXCRPW",$JOB,LOC,PROV,SORT))
if SORT=""!(POP)
QUIT
Begin DoDot:3
+11 SET (TOT(4),TOTE(4))=0
+12 SET VDT=""
FOR
SET VDT=$ORDER(^TMP("PXCRPW",$JOB,LOC,PROV,SORT,VDT))
if VDT=""!(POP)
QUIT
Begin DoDot:4
+13 SET (TOT(5),TOTE(5))=0
+14 SET VIN=""
FOR
SET VIN=$ORDER(^TMP("PXCRPW",$JOB,LOC,PROV,SORT,VDT,VIN))
SET HDR1=0
if VIN=""!(POP)
QUIT
Begin DoDot:5
+15 SET TOT(6)=0
+16 SET TOTE(5)=TOTE(5)+1
+17 SET PR=""
FOR
SET PR=$ORDER(^TMP("PXCRPW",$JOB,LOC,PROV,SORT,VDT,VIN,PR))
if PR=""
QUIT
Begin DoDot:6
+18 SET SHDR=0
+19 SET SDX=""
FOR
SET SDX=$ORDER(^TMP("PXCRPW",$JOB,LOC,PROV,SORT,VDT,VIN,PR,SDX))
if SDX=""!(POP)
QUIT
Begin DoDot:7
+20 SET REC=^TMP("PXCRPW",$JOB,LOC,PROV,SORT,VDT,VIN,PR,SDX)
+21 SET PAT=$$GET1^DIQ(9000010,REC_",",.05)
+22 SET SSN=$$GET1^DIQ(2,$$GET1^DIQ(9000010,REC_",",.05,"I"),.09)
+23 SET SSND=$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,9)
+24 SET EDT=$$GET1^DIQ(9000010,REC_",",.01)
+25 SET TYP=$$GET1^DIQ(9000010,REC_",",15001)
+26 SET USR=$$GET1^DIQ(9000010,REC_",",.23)
+27 if HDR=0
DO HEADER
if POP
QUIT
+28 IF RPTYP="D"
Begin DoDot:8
+29 IF HDR1=0
Begin DoDot:9
+30 WRITE !
SET $PIECE(HLINE,"-",132)=""
WRITE HLINE
+31 WRITE !,$EXTRACT(PAT,1,25),?26,SSND,?39,EDT,?59,$EXTRACT(TYP,1,15),?75,$EXTRACT(USR,1,15)
SET HDR1=1
End DoDot:9
+32 WRITE ?94,$EXTRACT(SDX,1,37),!
End DoDot:8
+33 SET TOT(6)=TOT(6)+1
+34 IF $Y>(IOSL-4)
SET HDR=0
End DoDot:7
+35 if POP
QUIT
End DoDot:6
+36 if POP
QUIT
+37 IF $Y>(IOSL-4)
DO HEADER
if POP
QUIT
+38 SET SHDR=1
+39 if RPTYP="D"
WRITE !?94,DEFD_TYP_": ",TOT(6),!
+40 SET TOT(5)=TOT(5)+TOT(6)
End DoDot:5
+41 if POP
QUIT
+42 WRITE !?6,DEFD_VDT_": ",TOT(5)
+43 WRITE !?6,ENCD_VDT_": ",TOTE(5)
+44 SET TOT(4)=TOT(4)+TOT(5)
+45 SET TOTE(4)=TOTE(4)+TOTE(5)
End DoDot:4
+46 if POP
QUIT
+47 WRITE !?4,DEFD_"SORT VALUE - "_$PIECE(SORT,"_",1)_": ",TOT(4)
+48 WRITE !?4,ENCD_"SORT VALUE - "_$PIECE(SORT,"_",1)_": ",TOTE(4)
+49 SET TOT(3)=TOT(3)+TOT(4)
+50 SET TOTE(3)=TOTE(3)+TOTE(4)
End DoDot:3
+51 if POP
QUIT
+52 WRITE !?2,DEFD_PROV_": ",TOT(3)
+53 WRITE !?2,ENCD_PROV_": ",TOTE(3)
+54 SET TOT(2)=TOT(2)+TOT(3)
+55 SET TOTE(2)=TOTE(2)+TOTE(3)
End DoDot:2
+56 if POP
QUIT
+57 WRITE !,DEFD_LOC_": ",TOT(2)
+58 WRITE !,ENCD_LOC_": ",TOTE(2)
+59 SET TOT(1)=TOT(1)+TOT(2)
+60 SET TOTE(1)=TOTE(1)+TOTE(2)
End DoDot:1
+61 if POP
QUIT
+62 IF TOT(1)+TOTE(1)=0
WRITE !!,"No Data to print",!
QUIT
+63 WRITE !!,"GRAND TOTAL NUMBER OF DEFECTS: ",TOT(1)
+64 WRITE !,"GRAND TOTAL NUMBER OF ENCOUNTERS = ",TOTE(1)
+65 QUIT
+66 ;
+1 NEW %,X,Y,MSG,HLINE,DLINE
+2 IF (PXPAGE>0)&(($EXTRACT(IOST)="C")&(IO=IO(0)))
Begin DoDot:1
+3 SET DIR(0)="E"
+4 WRITE !
+5 DO ^DIR
KILL DIR
End DoDot:1
+6 IF $DATA(DUOUT)!($DATA(DTOUT))
Begin DoDot:1
+7 SET POP=1
End DoDot:1
QUIT
+8 IF PXPAGE>0
if $DATA(IOF)
WRITE @IOF
+9 SET PXPAGE=PXPAGE+1
+10 WRITE !
+11 SET X=$$CTR132("PCE MISSING DATA REPORT")
WRITE !
+12 DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET X=$$CTR(Y)
WRITE !
+13 SET X=$$CTR132("By Clinic, Provider, and Date")
WRITE !
+14 SET Y=PX("BDT")
XECUTE ^DD("DD")
SET STDT=$PIECE(Y,"@",1)
+15 SET Y=PX("EDT")
XECUTE ^DD("DD")
SET ENDT=$PIECE(Y,"@",1)
+16 SET MSG=STDT_" through "_ENDT
+17 SET X=$$CTR(MSG)
WRITE !
+18 SET X=$$CTR132("Page "_PXPAGE)
WRITE !
+19 WRITE !!,"Patient",?26,"SSN",?39,"Date/Time",?59,"Enc. ID",?75,"Created by User",?94,"Defect",!
+20 SET $PIECE(HLINE,"=",132)=""
WRITE HLINE,!
+21 if SHDR
QUIT
+22 WRITE !,LOC
+23 WRITE !?2,PROV
+24 NEW SORTD
SET SORTD=$PIECE(SORT,"_",1)
+25 if SORTD=" "
SET SORTD="Unknown"
+26 NEW SORTHDR2
SET SORTHDR2=$PIECE(SORTHDR,U,PXSRT)
+27 IF SORTHDR2="DIAGNOSIS"
SET SORTHDR2=$SELECT($PIECE(SORT,"_",2)="30":"ICD10",1:"ICD9")
+28 WRITE !?4,"SORT VALUE: ",SORTHDR2,"= ",SORTD
+29 if VDT=""
SET VDT="Unknown"
+30 WRITE !?6,$PIECE(VDT,"@",1),":"
+31 SET HDR=1
+32 QUIT
+33 ;
CTR(X) ;
+1 WRITE ?(IOM-$LENGTH(X))\2,X
+2 QUIT 1
+3 ;
CTR132(X) ;
+1 WRITE ?(132-$LENGTH(X))\2,X
+2 QUIT 1
+3 ;
