- 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 Feb 18, 2025@23:57:08 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 ;