PSODEARX ;WILM/BDB - EPCS Utilities and Reports; [5/7/02 5:53am] ;3/3/22 14:50
;;7.0;OUTPATIENT PHARMACY;**545,731**;DEC 1997;Build 18
;External reference to DEA NUMBERS file (#8991.9) is supported by DBIA 7002
;
Q
;
DL ;Delimited File message
;
W !!,"You have selected the delimited file output." D YN Q:$G(PSOOUT)
W @IOF
W !,"The report output will be displayed on the screen in a delimited format, so"
W !,"it can be captured and exported. If you are using Reflections, you can turn"
W !,"logging on by selecting 'Tools' on the top of the screen, then"
W !,"select 'Logging' and capture to your desired location. To avoid undesired"
W !,"wrapping, you may need to set your terminal session display settings to"
W !,"132 columns. Please enter '0;132;9999' at the 'DEVICE:' prompt. Lines"
W !,"may need to be deleted at the top and bottom of the logged file before"
W !,"importing."
W !!,"The format of the output is as follows, using '|' as the delimiter:"
W !,"Name|IEN|DEA(#200)|Error Text"
D YN
Q
;
YN ;yes or no prompt if no audited fields found for a file
W ! K DIR,Y,PSOOUT S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR
I $D(DTOUT)!($D(DUOUT))!('Y) S PSOOUT=1
K DIRUT,DTOUT,DUOUT,DIR,X,Y
Q
;
RUN(PSHEADER) ; Run Report
N PSCOUNT2,PSOTD,PSONAME,POP,IOP,PSOION
S PSOION=ION,%ZIS="M" D ^%ZIS I POP S IOP=PSOION D ^%ZIS Q
K ^TMP($J,"PSODEARW") ; Clear the temporary accumulator
D COMPILE
U IO
W "Name","|","IEN","|","DEA","|","Error Text"
W " Run Date: ",$$FMTE^XLFDT(DT,"5DZ")
I '$D(^TMP($J,"PSODEARW")) W "There is no Data to Print",!
S PSCOUNT2=0 F S PSCOUNT2=$O(^TMP($J,"PSODEARW",PSCOUNT2)) Q:+PSCOUNT2=0 Q:PSOQ D
. W !,^TMP($J,"PSODEARW",PSCOUNT2,1),"|"
D ^%ZISC
K ^TMP($J,"PSODEARW") ; Clear the temporary accumulator
W !!,"End of Report. If 'Logging', please turn off 'Logging'.",! K DIR S DIR(0)="E",DIR("A")="Press Return to continue" D ^DIR K DIR
Q
;
COMPILE ; -- Compile the report lines into the sort global
N NAME,NPIEN,NPDEAIEN,ERROR,PRVNAME,NPDEA,DNDEA,PSOLINE,PSCOUNT1,NXNPIEN,NXDEAIEN
N DNDETOX,NXDEA,DETOXCT,DNINPT,DNINPTCT,INDIV,DNDEAIEN,DNDEASX,DNDEATYP
S ERROR(1)="MISSING DEA NUMBER IN (#8991.9)"
S ERROR(2)="PROVIDER NAME MISMATCH (#200)(#8991.9)"
S ERROR(3)="INSTITUTIONAL DEA MISSING SUFFIX"
S ERROR(4)="DEA ASSIGNED TO PROVIDER:"
S ERROR(5)="DUPLICATE DETOX NUMBER"
S ERROR(6)="PROVIDER WITH MULTIPLE DETOX NUMBERS"
S ERROR(7)="PROVIDER MISSING DEA INPATIENT FLAG"
S PSCOUNT1=0
S NAME="" F S NAME=$O(^VA(200,"B",NAME)) Q:NAME="" D
. S NPIEN=0 F S NPIEN=$O(^VA(200,"B",NAME,NPIEN)) Q:'NPIEN D
. . Q:'$D(^VA(200,NPIEN,"PS4"))
. . I '$O(^VA(200,NPIEN,"PS4",0)) Q
. . S PRVNAME=$$GET1^DIQ(200,NPIEN,.01,"E")
. . ;P731 detox/x-waiver removal
. . ;CHECK FOR PROVIDER WITH MULTIPLE DETOX NUMBERS ERROR 6
. . ;S DETOXCT=0,NPDEAIEN=0 F S NPDEAIEN=$O(^VA(200,NPIEN,"PS4",NPDEAIEN)) Q:'NPDEAIEN D I DETOXCT>1 Q
. . ;. S NPDEA=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.01,"E")
. . ;. S DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I")
. . ;. S DNDETOX=$$GET1^DIQ(8991.9,DNDEAIEN,.03) I DNDETOX]"" S DETOXCT=DETOXCT+1
. . ;. I DETOXCT>1 D
. . ;. . S PSOLINE="",NPDEA=""
. . ;. . S PSOLINE=PSOLINE_PRVNAME_"|" ; NAME #200, #.01
. . ;. . S PSOLINE=PSOLINE_NPIEN_"|" ; IEN #200
. . ;. . S PSOLINE=PSOLINE_NPDEA_"|" ; NEW DEA NUMBER #200,
. . ;. . S PSOLINE=PSOLINE_ERROR(6) ; ERROR TEXT
. . ;. . S PSCOUNT1=PSCOUNT1+1
. . ;. . S ^TMP($J,"PSODEARW",PSCOUNT1,1)=PSOLINE
. . ;CHECK FOR PROVIDER WITH ALL INDIVIDUAL DEA MISSING DEA INPATIENT FLAG ERROR 7
. . S INDIV=0,DNINPTCT=0,NPDEAIEN=0 F S NPDEAIEN=$O(^VA(200,NPIEN,"PS4",NPDEAIEN)) Q:'NPDEAIEN D I DNINPTCT>0 Q
. . . S NPDEA=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.01,"E")
. . . S DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I") Q:DNDEAIEN=""
. . . S DNDEATYP=$$GET1^DIQ(8991.9,DNDEAIEN,.07,"E") I DNDEATYP="INDIVIDUAL" S INDIV=1 D
. . . . S DNINPT=$$GET1^DIQ(8991.9,DNDEAIEN,.06) I DNINPT="YES" S DNINPTCT=DNINPTCT+1
. . I INDIV>0,DNINPTCT=0 D
. . . S PSOLINE="",NPDEA=""
. . . S PSOLINE=PSOLINE_PRVNAME_"|" ; NAME #200, #.01
. . . S PSOLINE=PSOLINE_NPIEN_"|" ; IEN #200
. . . S PSOLINE=PSOLINE_NPDEA_"|" ; NEW DEA NUMBER #200,
. . . S PSOLINE=PSOLINE_ERROR(7) ; ERROR TEXT
. . . S PSCOUNT1=PSCOUNT1+1
. . . S ^TMP($J,"PSODEARW",PSCOUNT1,1)=PSOLINE
. . ;CHECK EACH PROVIDER DEA
. . S NPDEAIEN=0 F S NPDEAIEN=$O(^VA(200,NPIEN,"PS4",NPDEAIEN)) Q:'NPDEAIEN D I DNDEA']"" Q
. . . ; CHECK FOR MISSING DEA NUMBER (FILE: #8991.9) ERROR 1
. . . S NPDEA=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.01,"E")
. . . S DNDEA=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"E")
. . . S DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I")
. . . I (DNDEA']"")!(NPDEA'=DNDEA) D
. . . . S PSOLINE=""
. . . . S PSOLINE=PSOLINE_PRVNAME_"|" ; NAME #200, #.01
. . . . S PSOLINE=PSOLINE_NPIEN_"|" ; IEN #200
. . . . S PSOLINE=PSOLINE_NPDEA_"|" ; NEW DEA NUMBER #200,
. . . . S PSOLINE=PSOLINE_ERROR(1) ; ERROR TEXT
. . . . S PSCOUNT1=PSCOUNT1+1
. . . . S ^TMP($J,"PSODEARW",PSCOUNT1,1)=PSOLINE
. . . ;CHECK FOR PROVIDER NAME MISMATCH (#200)(#8991.9) ERROR 2
. . . I (DNDEA]"")&($P(PRVNAME,",",1)'=$P($$GET1^DIQ(8991.9,DNDEAIEN,1.1),",",1)) D
. . . . S PSOLINE=""
. . . . S PSOLINE=PSOLINE_PRVNAME_"|" ; NAME #200, #.01
. . . . S PSOLINE=PSOLINE_NPIEN_"|" ; IEN #200
. . . . S PSOLINE=PSOLINE_NPDEA_"|" ; NEW DEA NUMBER #200,
. . . . S PSOLINE=PSOLINE_ERROR(2) ; ERROR TEXT
. . . . S PSCOUNT1=PSCOUNT1+1
. . . . S ^TMP($J,"PSODEARW",PSCOUNT1,1)=PSOLINE
. . . ;CHECK FOR INSTITUTIONAL DEA MISSING SUFFIX ERROR 3
. . . S DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I")
. . . S DNDEATYP=$$GET1^DIQ(8991.9,DNDEAIEN,.07,"E")
. . . S DNDEASX=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.02,"E")
. . . I (DNDEATYP="INSTITUTIONAL")&(DNDEASX="") D Q
. . . . S PSOLINE=""
. . . . S PSOLINE=PSOLINE_PRVNAME_"|" ; NAME #200, #.01
. . . . S PSOLINE=PSOLINE_NPIEN_"|" ; IEN #200
. . . . S PSOLINE=PSOLINE_NPDEA_"|" ; NEW DEA NUMBER #200,
. . . . S PSOLINE=PSOLINE_ERROR(3) ; ERROR TEXT
. . . . S PSCOUNT1=PSCOUNT1+1
. . . . S ^TMP($J,"PSODEARW",PSCOUNT1,1)=PSOLINE
. . . ;CHECK FOR DEA ASSIGNED TO PROVIDER: ERROR 4
. . . I DNDEATYP="INDIVIDUAL" S NXNPIEN="" F S NXNPIEN=$O(^VA(200,"PS4",NPDEA,NXNPIEN)) Q:NXNPIEN="" I NXNPIEN'=NPIEN D Q
. . . . S PSOLINE=""
. . . . S PSOLINE=PSOLINE_PRVNAME_"|" ; NAME #200, #.01
. . . . S PSOLINE=PSOLINE_NPIEN_"|" ; IEN #200
. . . . S PSOLINE=PSOLINE_NPDEA_"|" ; NEW DEA NUMBER #200,
. . . . S PSOLINE=PSOLINE_ERROR(4)_" "_$$GET1^DIQ(200,NXNPIEN_",",.01) ; ERROR TEXT
. . . . S PSCOUNT1=PSCOUNT1+1
. . . . S ^TMP($J,"PSODEARW",PSCOUNT1,1)=PSOLINE
. . . ;CHECK FOR DUPLICATE DETOX NUMBER
. . . ;P731 detox/x-waiver removal
. . . ;S DNDETOX=$$GET1^DIQ(8991.9,DNDEAIEN,.03)
. . . ;I DNDETOX]"" S NXDEA="" F S NXDEA=$O(^XTV(8991.9,"D",DNDETOX,NXDEA)) Q:NXDEA="" I NXDEA'=NPDEA D Q
. . . ;. S NXDEAIEN=$O(^XTV(8991.9,"D",DNDETOX,NXDEA,""))
. . . ;. S PSOLINE=""
. . . ;. S PSOLINE=PSOLINE_PRVNAME_"|" ; NAME #200, #.01
. . . ;. S PSOLINE=PSOLINE_NPIEN_"|" ; IEN #200
. . . ;. S PSOLINE=PSOLINE_NPDEA_"|" ; NEW DEA NUMBER #200,
. . . ;. S PSOLINE=PSOLINE_ERROR(5)_" DEA:"_$$GET1^DIQ(8991.9,NXDEAIEN_",",.01) ; ERROR TEXT
. . . ;. S PSCOUNT1=PSCOUNT1+1
. . . ;. S ^TMP($J,"PSODEARW",PSCOUNT1,1)=PSOLINE
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODEARX 8303 printed Apr 09, 2024@21:29:05 Page 2
PSODEARX ;WILM/BDB - EPCS Utilities and Reports; [5/7/02 5:53am] ;3/3/22 14:50
+1 ;;7.0;OUTPATIENT PHARMACY;**545,731**;DEC 1997;Build 18
+2 ;External reference to DEA NUMBERS file (#8991.9) is supported by DBIA 7002
+3 ;
+4 QUIT
+5 ;
DL ;Delimited File message
+1 ;
+2 WRITE !!,"You have selected the delimited file output."
DO YN
if $GET(PSOOUT)
QUIT
+3 WRITE @IOF
+4 WRITE !,"The report output will be displayed on the screen in a delimited format, so"
+5 WRITE !,"it can be captured and exported. If you are using Reflections, you can turn"
+6 WRITE !,"logging on by selecting 'Tools' on the top of the screen, then"
+7 WRITE !,"select 'Logging' and capture to your desired location. To avoid undesired"
+8 WRITE !,"wrapping, you may need to set your terminal session display settings to"
+9 WRITE !,"132 columns. Please enter '0;132;9999' at the 'DEVICE:' prompt. Lines"
+10 WRITE !,"may need to be deleted at the top and bottom of the logged file before"
+11 WRITE !,"importing."
+12 WRITE !!,"The format of the output is as follows, using '|' as the delimiter:"
+13 WRITE !,"Name|IEN|DEA(#200)|Error Text"
+14 DO YN
+15 QUIT
+16 ;
YN ;yes or no prompt if no audited fields found for a file
+1 WRITE !
KILL DIR,Y,PSOOUT
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
+2 IF $DATA(DTOUT)!($DATA(DUOUT))!('Y)
SET PSOOUT=1
+3 KILL DIRUT,DTOUT,DUOUT,DIR,X,Y
+4 QUIT
+5 ;
RUN(PSHEADER) ; Run Report
+1 NEW PSCOUNT2,PSOTD,PSONAME,POP,IOP,PSOION
+2 SET PSOION=ION
SET %ZIS="M"
DO ^%ZIS
IF POP
SET IOP=PSOION
DO ^%ZIS
QUIT
+3 ; Clear the temporary accumulator
KILL ^TMP($JOB,"PSODEARW")
+4 DO COMPILE
+5 USE IO
+6 WRITE "Name","|","IEN","|","DEA","|","Error Text"
+7 WRITE " Run Date: ",$$FMTE^XLFDT(DT,"5DZ")
+8 IF '$DATA(^TMP($JOB,"PSODEARW"))
WRITE "There is no Data to Print",!
+9 SET PSCOUNT2=0
FOR
SET PSCOUNT2=$ORDER(^TMP($JOB,"PSODEARW",PSCOUNT2))
if +PSCOUNT2=0
QUIT
if PSOQ
QUIT
Begin DoDot:1
+10 WRITE !,^TMP($JOB,"PSODEARW",PSCOUNT2,1),"|"
End DoDot:1
+11 DO ^%ZISC
+12 ; Clear the temporary accumulator
KILL ^TMP($JOB,"PSODEARW")
+13 WRITE !!,"End of Report. If 'Logging', please turn off 'Logging'.",!
KILL DIR
SET DIR(0)="E"
SET DIR("A")="Press Return to continue"
DO ^DIR
KILL DIR
+14 QUIT
+15 ;
COMPILE ; -- Compile the report lines into the sort global
+1 NEW NAME,NPIEN,NPDEAIEN,ERROR,PRVNAME,NPDEA,DNDEA,PSOLINE,PSCOUNT1,NXNPIEN,NXDEAIEN
+2 NEW DNDETOX,NXDEA,DETOXCT,DNINPT,DNINPTCT,INDIV,DNDEAIEN,DNDEASX,DNDEATYP
+3 SET ERROR(1)="MISSING DEA NUMBER IN (#8991.9)"
+4 SET ERROR(2)="PROVIDER NAME MISMATCH (#200)(#8991.9)"
+5 SET ERROR(3)="INSTITUTIONAL DEA MISSING SUFFIX"
+6 SET ERROR(4)="DEA ASSIGNED TO PROVIDER:"
+7 SET ERROR(5)="DUPLICATE DETOX NUMBER"
+8 SET ERROR(6)="PROVIDER WITH MULTIPLE DETOX NUMBERS"
+9 SET ERROR(7)="PROVIDER MISSING DEA INPATIENT FLAG"
+10 SET PSCOUNT1=0
+11 SET NAME=""
FOR
SET NAME=$ORDER(^VA(200,"B",NAME))
if NAME=""
QUIT
Begin DoDot:1
+12 SET NPIEN=0
FOR
SET NPIEN=$ORDER(^VA(200,"B",NAME,NPIEN))
if 'NPIEN
QUIT
Begin DoDot:2
+13 if '$DATA(^VA(200,NPIEN,"PS4"))
QUIT
+14 IF '$ORDER(^VA(200,NPIEN,"PS4",0))
QUIT
+15 SET PRVNAME=$$GET1^DIQ(200,NPIEN,.01,"E")
+16 ;P731 detox/x-waiver removal
+17 ;CHECK FOR PROVIDER WITH MULTIPLE DETOX NUMBERS ERROR 6
+18 ;S DETOXCT=0,NPDEAIEN=0 F S NPDEAIEN=$O(^VA(200,NPIEN,"PS4",NPDEAIEN)) Q:'NPDEAIEN D I DETOXCT>1 Q
+19 ;. S NPDEA=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.01,"E")
+20 ;. S DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I")
+21 ;. S DNDETOX=$$GET1^DIQ(8991.9,DNDEAIEN,.03) I DNDETOX]"" S DETOXCT=DETOXCT+1
+22 ;. I DETOXCT>1 D
+23 ;. . S PSOLINE="",NPDEA=""
+24 ;. . S PSOLINE=PSOLINE_PRVNAME_"|" ; NAME #200, #.01
+25 ;. . S PSOLINE=PSOLINE_NPIEN_"|" ; IEN #200
+26 ;. . S PSOLINE=PSOLINE_NPDEA_"|" ; NEW DEA NUMBER #200,
+27 ;. . S PSOLINE=PSOLINE_ERROR(6) ; ERROR TEXT
+28 ;. . S PSCOUNT1=PSCOUNT1+1
+29 ;. . S ^TMP($J,"PSODEARW",PSCOUNT1,1)=PSOLINE
+30 ;CHECK FOR PROVIDER WITH ALL INDIVIDUAL DEA MISSING DEA INPATIENT FLAG ERROR 7
+31 SET INDIV=0
SET DNINPTCT=0
SET NPDEAIEN=0
FOR
SET NPDEAIEN=$ORDER(^VA(200,NPIEN,"PS4",NPDEAIEN))
if 'NPDEAIEN
QUIT
Begin DoDot:3
+32 SET NPDEA=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.01,"E")
+33 SET DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I")
if DNDEAIEN=""
QUIT
+34 SET DNDEATYP=$$GET1^DIQ(8991.9,DNDEAIEN,.07,"E")
IF DNDEATYP="INDIVIDUAL"
SET INDIV=1
Begin DoDot:4
+35 SET DNINPT=$$GET1^DIQ(8991.9,DNDEAIEN,.06)
IF DNINPT="YES"
SET DNINPTCT=DNINPTCT+1
End DoDot:4
End DoDot:3
IF DNINPTCT>0
QUIT
+36 IF INDIV>0
IF DNINPTCT=0
Begin DoDot:3
+37 SET PSOLINE=""
SET NPDEA=""
+38 ; NAME #200, #.01
SET PSOLINE=PSOLINE_PRVNAME_"|"
+39 ; IEN #200
SET PSOLINE=PSOLINE_NPIEN_"|"
+40 ; NEW DEA NUMBER #200,
SET PSOLINE=PSOLINE_NPDEA_"|"
+41 ; ERROR TEXT
SET PSOLINE=PSOLINE_ERROR(7)
+42 SET PSCOUNT1=PSCOUNT1+1
+43 SET ^TMP($JOB,"PSODEARW",PSCOUNT1,1)=PSOLINE
End DoDot:3
+44 ;CHECK EACH PROVIDER DEA
+45 SET NPDEAIEN=0
FOR
SET NPDEAIEN=$ORDER(^VA(200,NPIEN,"PS4",NPDEAIEN))
if 'NPDEAIEN
QUIT
Begin DoDot:3
+46 ; CHECK FOR MISSING DEA NUMBER (FILE: #8991.9) ERROR 1
+47 SET NPDEA=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.01,"E")
+48 SET DNDEA=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"E")
+49 SET DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I")
+50 IF (DNDEA']"")!(NPDEA'=DNDEA)
Begin DoDot:4
+51 SET PSOLINE=""
+52 ; NAME #200, #.01
SET PSOLINE=PSOLINE_PRVNAME_"|"
+53 ; IEN #200
SET PSOLINE=PSOLINE_NPIEN_"|"
+54 ; NEW DEA NUMBER #200,
SET PSOLINE=PSOLINE_NPDEA_"|"
+55 ; ERROR TEXT
SET PSOLINE=PSOLINE_ERROR(1)
+56 SET PSCOUNT1=PSCOUNT1+1
+57 SET ^TMP($JOB,"PSODEARW",PSCOUNT1,1)=PSOLINE
End DoDot:4
+58 ;CHECK FOR PROVIDER NAME MISMATCH (#200)(#8991.9) ERROR 2
+59 IF (DNDEA]"")&($PIECE(PRVNAME,",",1)'=$PIECE($$GET1^DIQ(8991.9,DNDEAIEN,1.1),",",1))
Begin DoDot:4
+60 SET PSOLINE=""
+61 ; NAME #200, #.01
SET PSOLINE=PSOLINE_PRVNAME_"|"
+62 ; IEN #200
SET PSOLINE=PSOLINE_NPIEN_"|"
+63 ; NEW DEA NUMBER #200,
SET PSOLINE=PSOLINE_NPDEA_"|"
+64 ; ERROR TEXT
SET PSOLINE=PSOLINE_ERROR(2)
+65 SET PSCOUNT1=PSCOUNT1+1
+66 SET ^TMP($JOB,"PSODEARW",PSCOUNT1,1)=PSOLINE
End DoDot:4
+67 ;CHECK FOR INSTITUTIONAL DEA MISSING SUFFIX ERROR 3
+68 SET DNDEAIEN=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.03,"I")
+69 SET DNDEATYP=$$GET1^DIQ(8991.9,DNDEAIEN,.07,"E")
+70 SET DNDEASX=$$GET1^DIQ(200.5321,NPDEAIEN_","_NPIEN_",",.02,"E")
+71 IF (DNDEATYP="INSTITUTIONAL")&(DNDEASX="")
Begin DoDot:4
+72 SET PSOLINE=""
+73 ; NAME #200, #.01
SET PSOLINE=PSOLINE_PRVNAME_"|"
+74 ; IEN #200
SET PSOLINE=PSOLINE_NPIEN_"|"
+75 ; NEW DEA NUMBER #200,
SET PSOLINE=PSOLINE_NPDEA_"|"
+76 ; ERROR TEXT
SET PSOLINE=PSOLINE_ERROR(3)
+77 SET PSCOUNT1=PSCOUNT1+1
+78 SET ^TMP($JOB,"PSODEARW",PSCOUNT1,1)=PSOLINE
End DoDot:4
QUIT
+79 ;CHECK FOR DEA ASSIGNED TO PROVIDER: ERROR 4
+80 IF DNDEATYP="INDIVIDUAL"
SET NXNPIEN=""
FOR
SET NXNPIEN=$ORDER(^VA(200,"PS4",NPDEA,NXNPIEN))
if NXNPIEN=""
QUIT
IF NXNPIEN'=NPIEN
Begin DoDot:4
+81 SET PSOLINE=""
+82 ; NAME #200, #.01
SET PSOLINE=PSOLINE_PRVNAME_"|"
+83 ; IEN #200
SET PSOLINE=PSOLINE_NPIEN_"|"
+84 ; NEW DEA NUMBER #200,
SET PSOLINE=PSOLINE_NPDEA_"|"
+85 ; ERROR TEXT
SET PSOLINE=PSOLINE_ERROR(4)_" "_$$GET1^DIQ(200,NXNPIEN_",",.01)
+86 SET PSCOUNT1=PSCOUNT1+1
+87 SET ^TMP($JOB,"PSODEARW",PSCOUNT1,1)=PSOLINE
End DoDot:4
QUIT
+88 ;CHECK FOR DUPLICATE DETOX NUMBER
+89 ;P731 detox/x-waiver removal
+90 ;S DNDETOX=$$GET1^DIQ(8991.9,DNDEAIEN,.03)
+91 ;I DNDETOX]"" S NXDEA="" F S NXDEA=$O(^XTV(8991.9,"D",DNDETOX,NXDEA)) Q:NXDEA="" I NXDEA'=NPDEA D Q
+92 ;. S NXDEAIEN=$O(^XTV(8991.9,"D",DNDETOX,NXDEA,""))
+93 ;. S PSOLINE=""
+94 ;. S PSOLINE=PSOLINE_PRVNAME_"|" ; NAME #200, #.01
+95 ;. S PSOLINE=PSOLINE_NPIEN_"|" ; IEN #200
+96 ;. S PSOLINE=PSOLINE_NPDEA_"|" ; NEW DEA NUMBER #200,
+97 ;. S PSOLINE=PSOLINE_ERROR(5)_" DEA:"_$$GET1^DIQ(8991.9,NXDEAIEN_",",.01) ; ERROR TEXT
+98 ;. S PSCOUNT1=PSCOUNT1+1
+99 ;. S ^TMP($J,"PSODEARW",PSCOUNT1,1)=PSOLINE
End DoDot:3
IF DNDEA']""
QUIT
End DoDot:2
End DoDot:1
+100 QUIT
+101 ;
