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 Apr 09, 2024@21:28:43 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 ;
