- PXRRMDR ;BP/WLC - PCE Missing Data Report ;07/13/2021
- ;;1.0;PCE PATIENT CARE ENCOUNTER;**124,174,168,199,217**;FEB 11, 2004;Build 134
- ; 04/11/05 WLC changed to check for AO, IR and EC, only if SC'=YES
- Q
- ;
- EN N DIR,%DT,DT,DTOUT,DUOUT,CBU,CNT,EDT,LOC,PAT,POP,PRIO,PROV,PX,PXDS,PXDT
- N PXLOC,PXPAGE,PXPROV,RPTYP,SDDIV,SORT,SORTHDR,SSN,TY,VDT,X,Y,ZTSAVE
- S (POP,PXPAGE)=0
- K PXDS
- D HOME^%ZIS S:'$D(IOF) IOF=FF W @IOF,!!
- S X=$$CTR("PCE Missing Data Report")
- W !! D DATASRC^PXRRMDR1 G:POP EXIT ; sets PXDS() PX*1.0*174
- W @IOF,!! S X=$$CTR("**** Date Range Selection ****")
- W !!! S %DT="AEPX",%DT("A")="Beginning date: " D ^%DT G:Y<1 EXIT S PX("BDT")=Y
- EDT S %DT("A")=" Ending date: " W ! D ^%DT G:Y<1 EXIT
- I Y<PX("BDT") W !!,$C(7),"End date cannot be before begin date!",! G EDT
- S PX("EDT")=Y_.999999
- W @IOF,!! S X=$$CTR("*** Report Sort Selection ***")
- W !!! K DIR S SORTHDR="DATA SOURCE^CPT^DIAGNOSIS^PATIENT^ELIGIBILITY"
- F LOOP=1:1:$L(SORTHDR,U) S DESC=$P(SORTHDR,U,LOOP) W !,"("_LOOP_") "_DESC
- W ! S DIR(0)="N^^I X<1!(X>5) K X",DIR("A")="Enter number between 1 and 5" D ^DIR Q:$D(DIRUT) S PXSRT=+X
- S DIR(0)="S^D:DETAILED REPORT;S:STATISTICS ONLY",DIR("A")="Select report type",DIR("B")="DETAILED REPORT" D ^DIR Q:$D(DIRUT)
- S RPTYP=Y
- W !!,"This report requires 132 column output.",!
- S %ZIS="QM" D ^%ZIS Q:POP
- I $D(IO("Q")) D G EXIT
- . S ZTRTN="RUN^PXRRMDR",ZTDESC="PCE MISSING DATA REPORT"
- . S ZTSAVE("PX*")=""
- . S ZTSAVE("RPTYP")="",ZTSAVE("SORTHDR")=""
- . D ^%ZTLOAD W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
- .K ZTSK,IO("Q"),ZTSAVE D HOME^%ZIS
- ;
- RUN ;
- U IO
- K ^TMP("PXCRPW",$J),DIR S (PXOUT)=""
- N LOOP,PXDT,I,VSN,VISITS,CLASSIF
- S PXDT=(PX("BDT")-1)_.99999 K ^TMP("PXCRPW",$J)
- F S PXDT=$O(^AUPNVSIT("ADEL",PXDT)) Q:PXDT>PX("EDT")!('PXDT) D
- . S VSN=0 F S VSN=$O(^AUPNVSIT("ADEL",PXDT,VSN)) Q:'VSN D
- . . S VISITS=$P($G(^AUPNVSIT(VSN,812)),U,3) S:VISITS="" VISITS="Unknown"
- . . Q:'$D(PXDS(VISITS))
- . . D ENCEVENT^PXKENCOUNTER(VSN,0)
- . . Q:$P($G(^TMP("PXKENC",$J,VSN,"VST",VSN,0)),U,7)="E" ;Historic encounter PX*1.0*174
- . . Q:$$TESTPAT^VADPT($P($G(^TMP("PXKENC",$J,VSN,"VST",VSN,0)),U,5)) ;Test patient PX*1.0*174
- . . N OE S OE=$O(^SCE("AVSIT",VSN,0)) Q:'OE Q:$P(^SCE(OE,0),U,6)]"" Q:$P(^SCE(OE,0),U,12)=12 ;Check if a child encounter, non-count PX*1.0*174
- . . I '$D(^TMP("PXKENC",$J,VSN,"CPT")) D SET("Visit is missing a Procedure Code",1) Q
- . . I $$EXOE^SDCOU2(OE) Q ;Determine if Encounter is Exempt from Outpatient Classifications and Diagnoses PX*1.0*174
- . . N I,J S (I,CNT)=0 F S I=$O(^TMP("PXKENC",$J,VSN,"CPT",I)) Q:'I D
- . . . S CNT=0 F J=5,9,10,11,12,13,14,15 I $P(^TMP("PXKENC",$J,VSN,"CPT",I,0),U,J) S CNT=CNT+1
- . . . I CNT=0 D SET("Procedure: "_$$DISPLYP($P(^TMP("PXKENC",$J,VSN,"CPT",I,0),U))_" missing assoc. DXs",1)
- . . S (I,J)=0 F S I=$O(^TMP("PXKENC",$J,VSN,"POV",I)) Q:'I D
- . . . K CLASSIF S DFN=$$GET1^DIQ(9000010,VSN_",",.05,"I")
- . . . I $$AO^SDCO22(DFN) S CLASSIF(1)=""
- . . . I $$IR^SDCO22(DFN) S CLASSIF(2)=""
- . . . I $$SC^SDCO22(DFN) S CLASSIF(3)=""
- . . . I $$EC^SDCO22(DFN) S CLASSIF(4)=""
- . . . I $$MST^SDCO22(DFN) S CLASSIF(5)=""
- . . . I $$HNC^SDCO22(DFN) S CLASSIF(6)=""
- . . . I +$P($$CVEDT^DGCV(DFN,PXDT),"^",3) S CLASSIF(7)=""
- . . . I $$SHAD^SDCO22(DFN) S CLASSIF(8)=""
- . . . I $D(CLASSIF),'$D(^TMP("PXKENC",$J,VSN,"POV",I,800)) D SET($$DISPLYDX($P(^TMP("PXKENC",$J,VSN,"POV",I,0),U))_" missing SC/EI",1) Q
- . . . S J="" F S J=$O(CLASSIF(J)) Q:'J D
- . . . . N SCEIREC S SCEIREC=$G(^TMP("PXKENC",$J,VSN,"POV",I,800))
- . . . . I J=3&($P(SCEIREC,U,1)="") D SET($$DISPLYDX($P(^TMP("PXKENC",$J,VSN,"POV",I,0),U))_" missing Service Connect.",1)
- . . . . I J=1&($P(SCEIREC,U,2)="")&($P(SCEIREC,U,1)'=1) D SET($$DISPLYDX($P(^TMP("PXKENC",$J,VSN,"POV",I,0),U))_" missing Agent Orange",3)
- . . . . I J=2&($P(SCEIREC,U,3)="")&($P(SCEIREC,U,1)'=1) D SET($$DISPLYDX($P(^TMP("PXKENC",$J,VSN,"POV",I,0),U))_" missing Ion. Rad.",4)
- . . . . I J=4&($P(SCEIREC,U,4)="")&($P(SCEIREC,U,1)'=1) D SET($$DISPLYDX($P(^TMP("PXKENC",$J,VSN,"POV",I,0),U))_" missing Env. Contam.",5)
- . . . . I J=5&($P(SCEIREC,U,5)="") D SET($$DISPLYDX($P(^TMP("PXKENC",$J,VSN,"POV",I,0),U))_" missing MST",6)
- . . . . I J=6&($P(SCEIREC,U,6)="") D SET($$DISPLYDX($P(^TMP("PXKENC",$J,VSN,"POV",I,0),U))_" missing Head/Neck Cancer",6)
- . . . . I J=7&($P(SCEIREC,U,7)="") D SET($$DISPLYDX($P(^TMP("PXKENC",$J,VSN,"POV",I,0),U))_" missing Combat Vet",2)
- . . . . I J=8&($P(SCEIREC,U,8)="") D SET($$DISPLYDX($P(^TMP("PXKENC",$J,VSN,"POV",I,0),U))_" missing Project 112/SHAD",6)
- U IO D PRINT^PXRRMDR1,^%ZISC
- K ^TMP("PXCRPW",$J)
- EXIT Q
- ;
- STOP ;Check for stop task request
- S:$G(ZTQUEUED) (PXOUT,ZTSTOP)=$S($$S^%ZTLOAD:1,1:0)
- Q
- ;
- EVAL ;
- S PXLOC=$$GET1^DIQ(9000010,VSN_",",.22)
- S:$G(PXLOC)="" PXLOC="Unknown"
- N PXPTR S PXPTR=$O(^AUPNVPRV("AD",VSN,""))
- S PXPRV=$$GET1^DIQ(9000010.06,PXPTR_",",.01)
- S:$G(PRPRV)="" PXPRV="Unknown"
- Q
- ;
- DISPLYDX(PXCEPOV) ;
- N ICDSTR
- S ICDSTR=$$ICDDATA^ICDXCODE("DIAG",$P(PXCEPOV,"^"),$$CSDATE^PXDXUTL(VSN),"I")
- Q $S($P(ICDSTR,"^",20)="30":"ICD10",1:"ICD9")_": "_$P(ICDSTR,"^",2) ;code
- ;
- DISPLYP(PXCECPT) ;
- N CPTSTR
- S CPTSTR=$$CPT^ICPTCOD($P(PXCECPT,U),$P(^AUPNVSIT(VSN,0),"^"))
- Q $P(CPTSTR,U,2) ;code
- ;
- SET(SDX,PRIO) ;
- N A1
- S PRIO=$G(PRIO)
- D EVAL
- I PXSRT="" S A1="Unknown" D SET1(PRIO) Q
- D @PXSRT
- Q
- ;
- 1 ; Data Source
- S A1=$$GET1^DIQ(9000010,VSN_",",81203)
- S:A1="" A1=" "
- D SET1(PRIO)
- Q
- ;
- 2 ; CPT
- N CPT,CPT1
- S CPT=$O(^AUPNVCPT("AD",VSN,""))
- S:CPT'="" CPT1=$$GET1^DIQ(9000010.18,CPT_",",.01)
- S A1=$G(CPT1) D SET1(PRIO)
- Q
- ;
- 3 ; ICD
- N ICD,ICDCD,ICDDATA S ICD="",ICDCD="Unknown"
- F S ICD=$O(^AUPNVPOV("AD",VSN,ICD)) Q:'ICD D
- . S ICDCD=$$GET1^DIQ(9000010.07,ICD,.01)
- . S ICDDATA=$$ICDDATA^ICDXCODE("DIAG",ICDCD,$$CSDATE^PXDXUTL(VSN),"E")
- S A1=$S(ICDCD="Unknown":ICDCD,1:$P(ICDDATA,U,2)_"_"_$P(ICDDATA,U,20))
- D SET1(PRIO)
- Q
- ;
- 4 S A1=$$GET1^DIQ(9000010,VSN_",",.05)
- S:A1="" A1="Unknown"
- D SET1(PRIO)
- Q
- ;
- 5 ; Eligibility
- S A1=$$GET1^DIQ(9000010,VSN_",",.21)
- S:A1="" A1="Unknown"
- D SET1(PRIO)
- Q
- ;
- 6 ; Default Sort
- S A1="Default" D SET1(PRIO)
- Q
- ;
- SET1(PR) ; set temp global
- I A1="" S A1="Unknown"
- S Y=$$GET1^DIQ(9000010,VSN_",",.01) X ^DD("DD") S VDT=Y
- S:VDT="" VDT="Unknown" S VDT=$P(VDT,"@",1)
- S ^TMP("PXCRPW",$J,PXLOC,PXPRV,A1,VDT,VSN,PR,SDX)=VSN
- Q
- CTR(X) ;
- W ?(IOM-$L(X))\2,X
- Q 1
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPXRRMDR 6532 printed Mar 13, 2025@21:35:33 Page 2
- PXRRMDR ;BP/WLC - PCE Missing Data Report ;07/13/2021
- +1 ;;1.0;PCE PATIENT CARE ENCOUNTER;**124,174,168,199,217**;FEB 11, 2004;Build 134
- +2 ; 04/11/05 WLC changed to check for AO, IR and EC, only if SC'=YES
- +3 QUIT
- +4 ;
- EN NEW DIR,%DT,DT,DTOUT,DUOUT,CBU,CNT,EDT,LOC,PAT,POP,PRIO,PROV,PX,PXDS,PXDT
- +1 NEW PXLOC,PXPAGE,PXPROV,RPTYP,SDDIV,SORT,SORTHDR,SSN,TY,VDT,X,Y,ZTSAVE
- +2 SET (POP,PXPAGE)=0
- +3 KILL PXDS
- +4 DO HOME^%ZIS
- if '$DATA(IOF)
- SET IOF=FF
- WRITE @IOF,!!
- +5 SET X=$$CTR("PCE Missing Data Report")
- +6 ; sets PXDS() PX*1.0*174
- WRITE !!
- DO DATASRC^PXRRMDR1
- if POP
- GOTO EXIT
- +7 WRITE @IOF,!!
- SET X=$$CTR("**** Date Range Selection ****")
- +8 WRITE !!!
- SET %DT="AEPX"
- SET %DT("A")="Beginning date: "
- DO ^%DT
- if Y<1
- GOTO EXIT
- SET PX("BDT")=Y
- EDT SET %DT("A")=" Ending date: "
- WRITE !
- DO ^%DT
- if Y<1
- GOTO EXIT
- +1 IF Y<PX("BDT")
- WRITE !!,$CHAR(7),"End date cannot be before begin date!",!
- GOTO EDT
- +2 SET PX("EDT")=Y_.999999
- +3 WRITE @IOF,!!
- SET X=$$CTR("*** Report Sort Selection ***")
- +4 WRITE !!!
- KILL DIR
- SET SORTHDR="DATA SOURCE^CPT^DIAGNOSIS^PATIENT^ELIGIBILITY"
- +5 FOR LOOP=1:1:$LENGTH(SORTHDR,U)
- SET DESC=$PIECE(SORTHDR,U,LOOP)
- WRITE !,"("_LOOP_") "_DESC
- +6 WRITE !
- SET DIR(0)="N^^I X<1!(X>5) K X"
- SET DIR("A")="Enter number between 1 and 5"
- DO ^DIR
- if $DATA(DIRUT)
- QUIT
- SET PXSRT=+X
- +7 SET DIR(0)="S^D:DETAILED REPORT;S:STATISTICS ONLY"
- SET DIR("A")="Select report type"
- SET DIR("B")="DETAILED REPORT"
- DO ^DIR
- if $DATA(DIRUT)
- QUIT
- +8 SET RPTYP=Y
- +9 WRITE !!,"This report requires 132 column output.",!
- +10 SET %ZIS="QM"
- DO ^%ZIS
- if POP
- QUIT
- +11 IF $DATA(IO("Q"))
- Begin DoDot:1
- +12 SET ZTRTN="RUN^PXRRMDR"
- SET ZTDESC="PCE MISSING DATA REPORT"
- +13 SET ZTSAVE("PX*")=""
- +14 SET ZTSAVE("RPTYP")=""
- SET ZTSAVE("SORTHDR")=""
- +15 DO ^%ZTLOAD
- WRITE !!,$SELECT($DATA(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
- +16 KILL ZTSK,IO("Q"),ZTSAVE
- DO HOME^%ZIS
- End DoDot:1
- GOTO EXIT
- +17 ;
- RUN ;
- +1 USE IO
- +2 KILL ^TMP("PXCRPW",$JOB),DIR
- SET (PXOUT)=""
- +3 NEW LOOP,PXDT,I,VSN,VISITS,CLASSIF
- +4 SET PXDT=(PX("BDT")-1)_.99999
- KILL ^TMP("PXCRPW",$JOB)
- +5 FOR
- SET PXDT=$ORDER(^AUPNVSIT("ADEL",PXDT))
- if PXDT>PX("EDT")!('PXDT)
- QUIT
- Begin DoDot:1
- +6 SET VSN=0
- FOR
- SET VSN=$ORDER(^AUPNVSIT("ADEL",PXDT,VSN))
- if 'VSN
- QUIT
- Begin DoDot:2
- +7 SET VISITS=$PIECE($GET(^AUPNVSIT(VSN,812)),U,3)
- if VISITS=""
- SET VISITS="Unknown"
- +8 if '$DATA(PXDS(VISITS))
- QUIT
- +9 DO ENCEVENT^PXKENCOUNTER(VSN,0)
- +10 ;Historic encounter PX*1.0*174
- if $PIECE($GET(^TMP("PXKENC",$JOB,VSN,"VST",VSN,0)),U,7)="E"
- QUIT
- +11 ;Test patient PX*1.0*174
- if $$TESTPAT^VADPT($PIECE($GET(^TMP("PXKENC",$JOB,VSN,"VST",VSN,0)),U,5))
- QUIT
- +12 ;Check if a child encounter, non-count PX*1.0*174
- NEW OE
- SET OE=$ORDER(^SCE("AVSIT",VSN,0))
- if 'OE
- QUIT
- if $PIECE(^SCE(OE,0),U,6)]""
- QUIT
- if $PIECE(^SCE(OE,0),U,12)=12
- QUIT
- +13 IF '$DATA(^TMP("PXKENC",$JOB,VSN,"CPT"))
- DO SET("Visit is missing a Procedure Code",1)
- QUIT
- +14 ;Determine if Encounter is Exempt from Outpatient Classifications and Diagnoses PX*1.0*174
- IF $$EXOE^SDCOU2(OE)
- QUIT
- +15 NEW I,J
- SET (I,CNT)=0
- FOR
- SET I=$ORDER(^TMP("PXKENC",$JOB,VSN,"CPT",I))
- if 'I
- QUIT
- Begin DoDot:3
- +16 SET CNT=0
- FOR J=5,9,10,11,12,13,14,15
- IF $PIECE(^TMP("PXKENC",$JOB,VSN,"CPT",I,0),U,J)
- SET CNT=CNT+1
- +17 IF CNT=0
- DO SET("Procedure: "_$$DISPLYP($PIECE(^TMP("PXKENC",$JOB,VSN,"CPT",I,0),U))_" missing assoc. DXs",1)
- End DoDot:3
- +18 SET (I,J)=0
- FOR
- SET I=$ORDER(^TMP("PXKENC",$JOB,VSN,"POV",I))
- if 'I
- QUIT
- Begin DoDot:3
- +19 KILL CLASSIF
- SET DFN=$$GET1^DIQ(9000010,VSN_",",.05,"I")
- +20 IF $$AO^SDCO22(DFN)
- SET CLASSIF(1)=""
- +21 IF $$IR^SDCO22(DFN)
- SET CLASSIF(2)=""
- +22 IF $$SC^SDCO22(DFN)
- SET CLASSIF(3)=""
- +23 IF $$EC^SDCO22(DFN)
- SET CLASSIF(4)=""
- +24 IF $$MST^SDCO22(DFN)
- SET CLASSIF(5)=""
- +25 IF $$HNC^SDCO22(DFN)
- SET CLASSIF(6)=""
- +26 IF +$PIECE($$CVEDT^DGCV(DFN,PXDT),"^",3)
- SET CLASSIF(7)=""
- +27 IF $$SHAD^SDCO22(DFN)
- SET CLASSIF(8)=""
- +28 IF $DATA(CLASSIF)
- IF '$DATA(^TMP("PXKENC",$JOB,VSN,"POV",I,800))
- DO SET($$DISPLYDX($PIECE(^TMP("PXKENC",$JOB,VSN,"POV",I,0),U))_" missing SC/EI",1)
- QUIT
- +29 SET J=""
- FOR
- SET J=$ORDER(CLASSIF(J))
- if 'J
- QUIT
- Begin DoDot:4
- +30 NEW SCEIREC
- SET SCEIREC=$GET(^TMP("PXKENC",$JOB,VSN,"POV",I,800))
- +31 IF J=3&($PIECE(SCEIREC,U,1)="")
- DO SET($$DISPLYDX($PIECE(^TMP("PXKENC",$JOB,VSN,"POV",I,0),U))_" missing Service Connect.",1)
- +32 IF J=1&($PIECE(SCEIREC,U,2)="")&($PIECE(SCEIREC,U,1)'=1)
- DO SET($$DISPLYDX($PIECE(^TMP("PXKENC",$JOB,VSN,"POV",I,0),U))_" missing Agent Orange",3)
- +33 IF J=2&($PIECE(SCEIREC,U,3)="")&($PIECE(SCEIREC,U,1)'=1)
- DO SET($$DISPLYDX($PIECE(^TMP("PXKENC",$JOB,VSN,"POV",I,0),U))_" missing Ion. Rad.",4)
- +34 IF J=4&($PIECE(SCEIREC,U,4)="")&($PIECE(SCEIREC,U,1)'=1)
- DO SET($$DISPLYDX($PIECE(^TMP("PXKENC",$JOB,VSN,"POV",I,0),U))_" missing Env. Contam.",5)
- +35 IF J=5&($PIECE(SCEIREC,U,5)="")
- DO SET($$DISPLYDX($PIECE(^TMP("PXKENC",$JOB,VSN,"POV",I,0),U))_" missing MST",6)
- +36 IF J=6&($PIECE(SCEIREC,U,6)="")
- DO SET($$DISPLYDX($PIECE(^TMP("PXKENC",$JOB,VSN,"POV",I,0),U))_" missing Head/Neck Cancer",6)
- +37 IF J=7&($PIECE(SCEIREC,U,7)="")
- DO SET($$DISPLYDX($PIECE(^TMP("PXKENC",$JOB,VSN,"POV",I,0),U))_" missing Combat Vet",2)
- +38 IF J=8&($PIECE(SCEIREC,U,8)="")
- DO SET($$DISPLYDX($PIECE(^TMP("PXKENC",$JOB,VSN,"POV",I,0),U))_" missing Project 112/SHAD",6)
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +39 USE IO
- DO PRINT^PXRRMDR1
- DO ^%ZISC
- +40 KILL ^TMP("PXCRPW",$JOB)
- EXIT QUIT
- +1 ;
- STOP ;Check for stop task request
- +1 if $GET(ZTQUEUED)
- SET (PXOUT,ZTSTOP)=$SELECT($$S^%ZTLOAD:1,1:0)
- +2 QUIT
- +3 ;
- EVAL ;
- +1 SET PXLOC=$$GET1^DIQ(9000010,VSN_",",.22)
- +2 if $GET(PXLOC)=""
- SET PXLOC="Unknown"
- +3 NEW PXPTR
- SET PXPTR=$ORDER(^AUPNVPRV("AD",VSN,""))
- +4 SET PXPRV=$$GET1^DIQ(9000010.06,PXPTR_",",.01)
- +5 if $GET(PRPRV)=""
- SET PXPRV="Unknown"
- +6 QUIT
- +7 ;
- DISPLYDX(PXCEPOV) ;
- +1 NEW ICDSTR
- +2 SET ICDSTR=$$ICDDATA^ICDXCODE("DIAG",$PIECE(PXCEPOV,"^"),$$CSDATE^PXDXUTL(VSN),"I")
- +3 ;code
- QUIT $SELECT($PIECE(ICDSTR,"^",20)="30":"ICD10",1:"ICD9")_": "_$PIECE(ICDSTR,"^",2)
- +4 ;
- DISPLYP(PXCECPT) ;
- +1 NEW CPTSTR
- +2 SET CPTSTR=$$CPT^ICPTCOD($PIECE(PXCECPT,U),$PIECE(^AUPNVSIT(VSN,0),"^"))
- +3 ;code
- QUIT $PIECE(CPTSTR,U,2)
- +4 ;
- SET(SDX,PRIO) ;
- +1 NEW A1
- +2 SET PRIO=$GET(PRIO)
- +3 DO EVAL
- +4 IF PXSRT=""
- SET A1="Unknown"
- DO SET1(PRIO)
- QUIT
- +5 DO @PXSRT
- +6 QUIT
- +7 ;
- 1 ; Data Source
- +1 SET A1=$$GET1^DIQ(9000010,VSN_",",81203)
- +2 if A1=""
- SET A1=" "
- +3 DO SET1(PRIO)
- +4 QUIT
- +5 ;
- 2 ; CPT
- +1 NEW CPT,CPT1
- +2 SET CPT=$ORDER(^AUPNVCPT("AD",VSN,""))
- +3 if CPT'=""
- SET CPT1=$$GET1^DIQ(9000010.18,CPT_",",.01)
- +4 SET A1=$GET(CPT1)
- DO SET1(PRIO)
- +5 QUIT
- +6 ;
- 3 ; ICD
- +1 NEW ICD,ICDCD,ICDDATA
- SET ICD=""
- SET ICDCD="Unknown"
- +2 FOR
- SET ICD=$ORDER(^AUPNVPOV("AD",VSN,ICD))
- if 'ICD
- QUIT
- Begin DoDot:1
- +3 SET ICDCD=$$GET1^DIQ(9000010.07,ICD,.01)
- +4 SET ICDDATA=$$ICDDATA^ICDXCODE("DIAG",ICDCD,$$CSDATE^PXDXUTL(VSN),"E")
- End DoDot:1
- +5 SET A1=$SELECT(ICDCD="Unknown":ICDCD,1:$PIECE(ICDDATA,U,2)_"_"_$PIECE(ICDDATA,U,20))
- +6 DO SET1(PRIO)
- +7 QUIT
- +8 ;
- 4 SET A1=$$GET1^DIQ(9000010,VSN_",",.05)
- +1 if A1=""
- SET A1="Unknown"
- +2 DO SET1(PRIO)
- +3 QUIT
- +4 ;
- 5 ; Eligibility
- +1 SET A1=$$GET1^DIQ(9000010,VSN_",",.21)
- +2 if A1=""
- SET A1="Unknown"
- +3 DO SET1(PRIO)
- +4 QUIT
- +5 ;
- 6 ; Default Sort
- +1 SET A1="Default"
- DO SET1(PRIO)
- +2 QUIT
- +3 ;
- SET1(PR) ; set temp global
- +1 IF A1=""
- SET A1="Unknown"
- +2 SET Y=$$GET1^DIQ(9000010,VSN_",",.01)
- XECUTE ^DD("DD")
- SET VDT=Y
- +3 if VDT=""
- SET VDT="Unknown"
- SET VDT=$PIECE(VDT,"@",1)
- +4 SET ^TMP("PXCRPW",$JOB,PXLOC,PXPRV,A1,VDT,VSN,PR,SDX)=VSN
- +5 QUIT
- CTR(X) ;
- +1 WRITE ?(IOM-$LENGTH(X))\2,X
- +2 QUIT 1
- +3 ;
