PSODEARV ;WILM/BDB - EPCS Utilities and Reports; [5/7/02 5:53am] ;10/5/21 14:50
;;7.0;OUTPATIENT PHARMACY;**545,756**;DEC 1997;Build 3
;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 !,"512 columns. Please enter '0;512;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 !,"Term Date|Name|DEA|DEA Exp Dt|Last Sign-on|Title|Service/Section|Remarks"
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,PSCPRSSA,PSOEDS,PSOCPRSU) ; Run Report
N PSCOUNT2,PSOTD,PSONAME,POP,IOP,PSOION,PSOPROB
S PSOPROB="",PSOION=ION,%ZIS="M" D ^%ZIS I POP S IOP=PSOION D ^%ZIS Q
K ^TMP($J,"PSODEARP") ; Clear the temporary accumulator
D COMPILE(PSCPRSSA,PSOEDS,PSOCPRSU,.PSOPROB)
U IO
W "Term Date","|","Name","|","DEA","|","DEA Exp Dt","|","Last Sign-on","|","Title","|","Service/Section","|","Remarks"
W !,"DEA Expiration Date Report"_" "
W PSHEADER
W "Run Date: ",$$FMTE^XLFDT(DT,"5DZ")
I '$D(^TMP($J,"PSODEARP")) W !!,"There is no Data to Print"
S PSOTD=0 F S PSOTD=$O(^TMP($J,"PSODEARP",PSOTD)) Q:+PSOTD=0 D
. S PSONAME="" F S PSONAME=$O(^TMP($J,"PSODEARP",PSOTD,PSONAME)) Q:PSONAME="" D
.. S PSCOUNT2=0 F S PSCOUNT2=$O(^TMP($J,"PSODEARP",PSOTD,PSONAME,PSCOUNT2)) Q:+PSCOUNT2=0 D
... W !,^TMP($J,"PSODEARP",PSOTD,PSONAME,PSCOUNT2,1),"|"
I $G(PSOPROB) D
. W !,"*PROBLEM* INDICATES BAD CROSS REFERENCE IN NEW PERSON FILE.",!,"CONTACT PRODUCT SUPPORT TO RESOLVE.",!
D ^%ZISC
K ^TMP($J,"PSODEARP") ; 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(PSCPRSSA,PSOEDS,PSOCPRSU,PSOPROB) ; -- Compile the report lines into the sort global
N DEAIEN,DEATXT,PSCOUNT1,PSOLINE,PSOTD
S PSCOUNT1=0
S DEATXT="" F S DEATXT=$O(^XTV(8991.9,"B",DEATXT)) Q:DEATXT="" D
. S DEAIEN=$O(^XTV(8991.9,"B",DEATXT,0)) Q:'DEAIEN
. S NPIEN="" F S NPIEN=$O(^VA(200,"PS4",DEATXT,NPIEN)) Q:'NPIEN D
. . K TMP,PSODNOBJ D GETS^DIQ(8991.9,DEAIEN_",","**","","TMP","MSG") M PSODNOBJ=TMP(8991.9,DEAIEN_",")
. . K TMP,PSONPOBJ D GETS^DIQ(200,NPIEN_",","**","","TMP","MSG") M PSONPOBJ=TMP(200,NPIEN_",")
. . S (PSOTD,PSONPOBJ(9.2))=$$GET1^DIQ(200,NPIEN_",",9.2,"I"),PSONPOBJ(9.2)=$$FMTE^XLFDT(PSONPOBJ(9.2),"5DZ")
. . S PSONPOBJ(202)=$$GET1^DIQ(200,NPIEN_",",202,"I"),PSONPOBJ(202)=$$FMTE^XLFDT(PSONPOBJ(202),"5DZ")
. . S PSODNOBJ(.04)=$$GET1^DIQ(8991.9,DEAIEN_",",.04,"I"),PSODNOBJ(.04)=$$FMTE^XLFDT(PSODNOBJ(.04),"5DZ")
. . Q:'$$TEST(.PSODNOBJ,.PSONPOBJ,PSCPRSSA,PSOEDS,NPIEN,PSOCPRSU)
. . N P200P5321 S P200P5321=$$FIND1^DIC(200.5321,","_NPIEN_",",,DEATXT)
. . I '$G(P200P5321) S PSODNOBJ(.01)="*PROBLEM*",PSOPROB=$G(PSOPROB)+1
. . S PSOLINE=""
. . S PSOLINE=PSOLINE_PSONPOBJ(9.2)_"|" ; TERMINATION DATE #200, #9.2
. . S PSOLINE=PSOLINE_PSONPOBJ(.01)_"|" ; NAME #200, #.01
. . S PSOLINE=PSOLINE_PSODNOBJ(.01)_"|" ; DEA #8991.9, #.01
. . S PSOLINE=PSOLINE_PSODNOBJ(.04)_"|" ; DEA Expiration Date #8991.9, #.04
. . S PSOLINE=PSOLINE_PSONPOBJ(202)_"|" ; LAST SIGN-ON #200, #202
. . S PSOLINE=PSOLINE_PSONPOBJ(8)_"|" ; TITLE #200, #8
. . S PSOLINE=PSOLINE_PSONPOBJ(29)_"|" ; SERVICE/SECTION #200, #29
. . S PSCOUNT1=PSCOUNT1+1
. . S PSOTD=$S(PSOTD:PSOTD,1:1)
. . ;p756 use Name field .01 from file 200
. . S ^TMP($J,"PSODEARP",PSOTD,PSONPOBJ(.01),PSCOUNT1,1)=PSOLINE
. . ;
. . D:PSONPOBJ(53.9)'=""
. . . S PSOLINE=PSOLINE_"REMARKS: "_PSONPOBJ(53.9)_"|" ; REMARKS FIELD #200, #53.9
. . . ;p756 use Name field .01 from file 200
. . . S ^TMP($J,"PSODEARP",PSOTD,PSONPOBJ(.01),PSCOUNT1,1)=PSOLINE
Q
;
TEST(PSODNOBJ,PSONPOBJ,PSCPRSSA,PSOEDS,NPIEN,PSOCPRSU) ; -- Perform the requested test for screening critera
N DEAEXPDT D DT^DILF("",PSODNOBJ(.04),.DEAEXPDT)
N RESP,PSOACC S RESP=0
N PSOTERM,PSOTODAY
S PSOTERM=$$GET1^DIQ(200,NPIEN,9.2,"I")
S PSOTODAY=$$DT^XLFDT
S PSOACC=$$GET1^DIQ(200,NPIEN,2,"I")
;
; Provider Active and DEA is expired.
I PSOCPRSU,((PSCPRSSA="A")!(PSCPRSSA="B")),PSOEDS="E",$$ACTIVE^XUSER(NPIEN),PSODNOBJ(.04)'="",(DEAEXPDT<$$DT^XLFDT()) Q 1 ; Active CPRS Providers Only
; All (CPRS and Non-CPRS) Active Providers and DEA is expired
I 'PSOCPRSU,((PSCPRSSA="A")!(PSCPRSSA="B")),PSOEDS="E",PSONPOBJ(7)'="YES",('PSOTERM!(PSOTERM>PSOTODAY)),PSODNOBJ(.04)'="",(DEAEXPDT<$$DT^XLFDT()) Q 1 ; All Active Providers
;
; CPRS Provider Active and does not have a DEA expiration date.
I PSOCPRSU,((PSCPRSSA="A")!(PSCPRSSA="B")),PSOEDS="N",$$ACTIVE^XUSER(NPIEN),PSODNOBJ(.04)="" Q 1 ; Active CPRS Providers Only
; All (CPRS and Non-CPRS) Active Provider and does not have a DEA expiration date.
I 'PSOCPRSU,((PSCPRSSA="A")!(PSCPRSSA="B")),PSOEDS="N",PSONPOBJ(7)'="YES",('PSOTERM!(PSOTERM>PSOTODAY)),PSODNOBJ(.04)="" Q 1 ; All Active Providers
;
; CPRS Provider Active and DEA is expiring within next 30 days.
I PSOCPRSU,((PSCPRSSA="A")!(PSCPRSSA="B")),PSOEDS="3",$$ACTIVE^XUSER(NPIEN),PSODNOBJ(.04)'="",DEAEXPDT<$$FMADD^XLFDT(DT,30),DEAEXPDT>$$FMADD^XLFDT(DT,-1) Q 1 ; Active CPRS Providers Only
; All (CPRS and Non-CPRS) Active Provider and DEA is expiring within next 30 days.
I 'PSOCPRSU,((PSCPRSSA="A")!(PSCPRSSA="B")),PSOEDS="3",PSONPOBJ(7)'="YES",('PSOTERM!(PSOTERM>PSOTODAY)),PSODNOBJ(.04)'="",(DEAEXPDT'>$$FMADD^XLFDT(DT,30)),DEAEXPDT>$$FMADD^XLFDT(DT,-1) Q 1 ; All Active Providers
;
; CPRS Provider Active and DEA expiring within the next 90 days.
I PSOCPRSU,((PSCPRSSA="A")!(PSCPRSSA="B")),PSOEDS="9",$$ACTIVE^XUSER(NPIEN),PSODNOBJ(.04)'="",DEAEXPDT<$$FMADD^XLFDT(DT,90),DEAEXPDT>$$FMADD^XLFDT(DT,-1) Q 1 ; Active CPRS Providers Only
; All (CPRS and Non-CPRS) Active DEA expiring within the next 90 days.
I 'PSOCPRSU,((PSCPRSSA="A")!(PSCPRSSA="B")),PSOEDS="9",PSONPOBJ(7)'="YES",('PSOTERM!(PSOTERM>PSOTODAY)),PSODNOBJ(.04)'="",(DEAEXPDT'>$$FMADD^XLFDT(DT,90)),DEAEXPDT>$$FMADD^XLFDT(DT,-1) Q 1 ; All Active Providers
;
; CPRS Provider disusered and DEA is expired.
I PSOCPRSU,$L(PSOACC),((PSCPRSSA="D")!(PSCPRSSA="B")),PSOEDS="E",((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY))),PSODNOBJ(.04)'="",(DEAEXPDT<$$DT^XLFDT()) Q 1
; All (CPRS and Non-CPRS) disusered provider and DEA is expired.
I 'PSOCPRSU,((PSCPRSSA="D")!(PSCPRSSA="B")),PSOEDS="E",((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY))),PSODNOBJ(.04)'="",(DEAEXPDT<$$DT^XLFDT()) Q 1
;
; CPRS Provider disusered and does not have a DEA expiration date.
I PSOCPRSU,$L(PSOACC),((PSCPRSSA="D")!(PSCPRSSA="B")),PSOEDS="N",((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY))),PSODNOBJ(.04)="" Q 1
; All (CPRS and Non-CPRS) disusered provider and does not have a DEA expiration date.
I 'PSOCPRSU,((PSCPRSSA="D")!(PSCPRSSA="B")),PSOEDS="N",((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY))),PSODNOBJ(.04)="" Q 1
;
; CPRS Provider disusered and DEA is expiring within the next 30 days.
I PSOCPRSU,$L(PSOACC),((PSCPRSSA="D")!(PSCPRSSA="B")),PSOEDS="3",((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY))),PSODNOBJ(.04)'="",(DEAEXPDT'>$$FMADD^XLFDT(DT,30)),DEAEXPDT>$$FMADD^XLFDT(DT,-1) Q 1
; All (CPRS and Non-CPRS) disusered Provider and DEA is expiring within the next 30 days.
I 'PSOCPRSU,((PSCPRSSA="D")!(PSCPRSSA="B")),PSOEDS="3",((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY))),PSODNOBJ(.04)'="",(DEAEXPDT'>$$FMADD^XLFDT(DT,30)),DEAEXPDT>$$FMADD^XLFDT(DT,-1) Q 1
;
; CPRS Provider disusered and DEA is expiring within the next 90 days.
I PSOCPRSU,$L(PSOACC),((PSCPRSSA="D")!(PSCPRSSA="B")),PSOEDS="9",((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY))),PSODNOBJ(.04)'="",(DEAEXPDT'>$$FMADD^XLFDT(DT,90)),DEAEXPDT>$$FMADD^XLFDT(DT,-1) Q 1
; All (CPRS and Non-CPRS) disusered and DEA is expiring within the next 90 days.
I 'PSOCPRSU,((PSCPRSSA="D")!(PSCPRSSA="B")),PSOEDS="9",((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY))),PSODNOBJ(.04)'="",(DEAEXPDT'>$$FMADD^XLFDT(DT,90)),DEAEXPDT>$$FMADD^XLFDT(DT,-1) Q 1
;
Q RESP
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSODEARV 9043 printed Dec 13, 2024@02:26:42 Page 2
PSODEARV ;WILM/BDB - EPCS Utilities and Reports; [5/7/02 5:53am] ;10/5/21 14:50
+1 ;;7.0;OUTPATIENT PHARMACY;**545,756**;DEC 1997;Build 3
+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 !,"512 columns. Please enter '0;512;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 !,"Term Date|Name|DEA|DEA Exp Dt|Last Sign-on|Title|Service/Section|Remarks"
+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,PSCPRSSA,PSOEDS,PSOCPRSU) ; Run Report
+1 NEW PSCOUNT2,PSOTD,PSONAME,POP,IOP,PSOION,PSOPROB
+2 SET PSOPROB=""
SET PSOION=ION
SET %ZIS="M"
DO ^%ZIS
IF POP
SET IOP=PSOION
DO ^%ZIS
QUIT
+3 ; Clear the temporary accumulator
KILL ^TMP($JOB,"PSODEARP")
+4 DO COMPILE(PSCPRSSA,PSOEDS,PSOCPRSU,.PSOPROB)
+5 USE IO
+6 WRITE "Term Date","|","Name","|","DEA","|","DEA Exp Dt","|","Last Sign-on","|","Title","|","Service/Section","|","Remarks"
+7 WRITE !,"DEA Expiration Date Report"_" "
+8 WRITE PSHEADER
+9 WRITE "Run Date: ",$$FMTE^XLFDT(DT,"5DZ")
+10 IF '$DATA(^TMP($JOB,"PSODEARP"))
WRITE !!,"There is no Data to Print"
+11 SET PSOTD=0
FOR
SET PSOTD=$ORDER(^TMP($JOB,"PSODEARP",PSOTD))
if +PSOTD=0
QUIT
Begin DoDot:1
+12 SET PSONAME=""
FOR
SET PSONAME=$ORDER(^TMP($JOB,"PSODEARP",PSOTD,PSONAME))
if PSONAME=""
QUIT
Begin DoDot:2
+13 SET PSCOUNT2=0
FOR
SET PSCOUNT2=$ORDER(^TMP($JOB,"PSODEARP",PSOTD,PSONAME,PSCOUNT2))
if +PSCOUNT2=0
QUIT
Begin DoDot:3
+14 WRITE !,^TMP($JOB,"PSODEARP",PSOTD,PSONAME,PSCOUNT2,1),"|"
End DoDot:3
End DoDot:2
End DoDot:1
+15 IF $GET(PSOPROB)
Begin DoDot:1
+16 WRITE !,"*PROBLEM* INDICATES BAD CROSS REFERENCE IN NEW PERSON FILE.",!,"CONTACT PRODUCT SUPPORT TO RESOLVE.",!
End DoDot:1
+17 DO ^%ZISC
+18 ; Clear the temporary accumulator
KILL ^TMP($JOB,"PSODEARP")
+19 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
+20 QUIT
+21 ;
COMPILE(PSCPRSSA,PSOEDS,PSOCPRSU,PSOPROB) ; -- Compile the report lines into the sort global
+1 NEW DEAIEN,DEATXT,PSCOUNT1,PSOLINE,PSOTD
+2 SET PSCOUNT1=0
+3 SET DEATXT=""
FOR
SET DEATXT=$ORDER(^XTV(8991.9,"B",DEATXT))
if DEATXT=""
QUIT
Begin DoDot:1
+4 SET DEAIEN=$ORDER(^XTV(8991.9,"B",DEATXT,0))
if 'DEAIEN
QUIT
+5 SET NPIEN=""
FOR
SET NPIEN=$ORDER(^VA(200,"PS4",DEATXT,NPIEN))
if 'NPIEN
QUIT
Begin DoDot:2
+6 KILL TMP,PSODNOBJ
DO GETS^DIQ(8991.9,DEAIEN_",","**","","TMP","MSG")
MERGE PSODNOBJ=TMP(8991.9,DEAIEN_",")
+7 KILL TMP,PSONPOBJ
DO GETS^DIQ(200,NPIEN_",","**","","TMP","MSG")
MERGE PSONPOBJ=TMP(200,NPIEN_",")
+8 SET (PSOTD,PSONPOBJ(9.2))=$$GET1^DIQ(200,NPIEN_",",9.2,"I")
SET PSONPOBJ(9.2)=$$FMTE^XLFDT(PSONPOBJ(9.2),"5DZ")
+9 SET PSONPOBJ(202)=$$GET1^DIQ(200,NPIEN_",",202,"I")
SET PSONPOBJ(202)=$$FMTE^XLFDT(PSONPOBJ(202),"5DZ")
+10 SET PSODNOBJ(.04)=$$GET1^DIQ(8991.9,DEAIEN_",",.04,"I")
SET PSODNOBJ(.04)=$$FMTE^XLFDT(PSODNOBJ(.04),"5DZ")
+11 if '$$TEST(.PSODNOBJ,.PSONPOBJ,PSCPRSSA,PSOEDS,NPIEN,PSOCPRSU)
QUIT
+12 NEW P200P5321
SET P200P5321=$$FIND1^DIC(200.5321,","_NPIEN_",",,DEATXT)
+13 IF '$GET(P200P5321)
SET PSODNOBJ(.01)="*PROBLEM*"
SET PSOPROB=$GET(PSOPROB)+1
+14 SET PSOLINE=""
+15 ; TERMINATION DATE #200, #9.2
SET PSOLINE=PSOLINE_PSONPOBJ(9.2)_"|"
+16 ; NAME #200, #.01
SET PSOLINE=PSOLINE_PSONPOBJ(.01)_"|"
+17 ; DEA #8991.9, #.01
SET PSOLINE=PSOLINE_PSODNOBJ(.01)_"|"
+18 ; DEA Expiration Date #8991.9, #.04
SET PSOLINE=PSOLINE_PSODNOBJ(.04)_"|"
+19 ; LAST SIGN-ON #200, #202
SET PSOLINE=PSOLINE_PSONPOBJ(202)_"|"
+20 ; TITLE #200, #8
SET PSOLINE=PSOLINE_PSONPOBJ(8)_"|"
+21 ; SERVICE/SECTION #200, #29
SET PSOLINE=PSOLINE_PSONPOBJ(29)_"|"
+22 SET PSCOUNT1=PSCOUNT1+1
+23 SET PSOTD=$SELECT(PSOTD:PSOTD,1:1)
+24 ;p756 use Name field .01 from file 200
+25 SET ^TMP($JOB,"PSODEARP",PSOTD,PSONPOBJ(.01),PSCOUNT1,1)=PSOLINE
+26 ;
+27 if PSONPOBJ(53.9)'=""
Begin DoDot:3
+28 ; REMARKS FIELD #200, #53.9
SET PSOLINE=PSOLINE_"REMARKS: "_PSONPOBJ(53.9)_"|"
+29 ;p756 use Name field .01 from file 200
+30 SET ^TMP($JOB,"PSODEARP",PSOTD,PSONPOBJ(.01),PSCOUNT1,1)=PSOLINE
End DoDot:3
End DoDot:2
End DoDot:1
+31 QUIT
+32 ;
TEST(PSODNOBJ,PSONPOBJ,PSCPRSSA,PSOEDS,NPIEN,PSOCPRSU) ; -- Perform the requested test for screening critera
+1 NEW DEAEXPDT
DO DT^DILF("",PSODNOBJ(.04),.DEAEXPDT)
+2 NEW RESP,PSOACC
SET RESP=0
+3 NEW PSOTERM,PSOTODAY
+4 SET PSOTERM=$$GET1^DIQ(200,NPIEN,9.2,"I")
+5 SET PSOTODAY=$$DT^XLFDT
+6 SET PSOACC=$$GET1^DIQ(200,NPIEN,2,"I")
+7 ;
+8 ; Provider Active and DEA is expired.
+9 ; Active CPRS Providers Only
IF PSOCPRSU
IF ((PSCPRSSA="A")!(PSCPRSSA="B"))
IF PSOEDS="E"
IF $$ACTIVE^XUSER(NPIEN)
IF PSODNOBJ(.04)'=""
IF (DEAEXPDT<$$DT^XLFDT())
QUIT 1
+10 ; All (CPRS and Non-CPRS) Active Providers and DEA is expired
+11 ; All Active Providers
IF 'PSOCPRSU
IF ((PSCPRSSA="A")!(PSCPRSSA="B"))
IF PSOEDS="E"
IF PSONPOBJ(7)'="YES"
IF ('PSOTERM!(PSOTERM>PSOTODAY))
IF PSODNOBJ(.04)'=""
IF (DEAEXPDT<$$DT^XLFDT())
QUIT 1
+12 ;
+13 ; CPRS Provider Active and does not have a DEA expiration date.
+14 ; Active CPRS Providers Only
IF PSOCPRSU
IF ((PSCPRSSA="A")!(PSCPRSSA="B"))
IF PSOEDS="N"
IF $$ACTIVE^XUSER(NPIEN)
IF PSODNOBJ(.04)=""
QUIT 1
+15 ; All (CPRS and Non-CPRS) Active Provider and does not have a DEA expiration date.
+16 ; All Active Providers
IF 'PSOCPRSU
IF ((PSCPRSSA="A")!(PSCPRSSA="B"))
IF PSOEDS="N"
IF PSONPOBJ(7)'="YES"
IF ('PSOTERM!(PSOTERM>PSOTODAY))
IF PSODNOBJ(.04)=""
QUIT 1
+17 ;
+18 ; CPRS Provider Active and DEA is expiring within next 30 days.
+19 ; Active CPRS Providers Only
IF PSOCPRSU
IF ((PSCPRSSA="A")!(PSCPRSSA="B"))
IF PSOEDS="3"
IF $$ACTIVE^XUSER(NPIEN)
IF PSODNOBJ(.04)'=""
IF DEAEXPDT<$$FMADD^XLFDT(DT,30)
IF DEAEXPDT>$$FMADD^XLFDT(DT,-1)
QUIT 1
+20 ; All (CPRS and Non-CPRS) Active Provider and DEA is expiring within next 30 days.
+21 ; All Active Providers
IF 'PSOCPRSU
IF ((PSCPRSSA="A")!(PSCPRSSA="B"))
IF PSOEDS="3"
IF PSONPOBJ(7)'="YES"
IF ('PSOTERM!(PSOTERM>PSOTODAY))
IF PSODNOBJ(.04)'=""
IF (DEAEXPDT'>$$FMADD^XLFDT(DT,30))
IF DEAEXPDT>$$FMADD^XLFDT(DT,-1)
QUIT 1
+22 ;
+23 ; CPRS Provider Active and DEA expiring within the next 90 days.
+24 ; Active CPRS Providers Only
IF PSOCPRSU
IF ((PSCPRSSA="A")!(PSCPRSSA="B"))
IF PSOEDS="9"
IF $$ACTIVE^XUSER(NPIEN)
IF PSODNOBJ(.04)'=""
IF DEAEXPDT<$$FMADD^XLFDT(DT,90)
IF DEAEXPDT>$$FMADD^XLFDT(DT,-1)
QUIT 1
+25 ; All (CPRS and Non-CPRS) Active DEA expiring within the next 90 days.
+26 ; All Active Providers
IF 'PSOCPRSU
IF ((PSCPRSSA="A")!(PSCPRSSA="B"))
IF PSOEDS="9"
IF PSONPOBJ(7)'="YES"
IF ('PSOTERM!(PSOTERM>PSOTODAY))
IF PSODNOBJ(.04)'=""
IF (DEAEXPDT'>$$FMADD^XLFDT(DT,90))
IF DEAEXPDT>$$FMADD^XLFDT(DT,-1)
QUIT 1
+27 ;
+28 ; CPRS Provider disusered and DEA is expired.
+29 IF PSOCPRSU
IF $LENGTH(PSOACC)
IF ((PSCPRSSA="D")!(PSCPRSSA="B"))
IF PSOEDS="E"
IF ((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY)))
IF PSODNOBJ(.04)'=""
IF (DEAEXPDT<$$DT^XLFDT())
QUIT 1
+30 ; All (CPRS and Non-CPRS) disusered provider and DEA is expired.
+31 IF 'PSOCPRSU
IF ((PSCPRSSA="D")!(PSCPRSSA="B"))
IF PSOEDS="E"
IF ((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY)))
IF PSODNOBJ(.04)'=""
IF (DEAEXPDT<$$DT^XLFDT())
QUIT 1
+32 ;
+33 ; CPRS Provider disusered and does not have a DEA expiration date.
+34 IF PSOCPRSU
IF $LENGTH(PSOACC)
IF ((PSCPRSSA="D")!(PSCPRSSA="B"))
IF PSOEDS="N"
IF ((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY)))
IF PSODNOBJ(.04)=""
QUIT 1
+35 ; All (CPRS and Non-CPRS) disusered provider and does not have a DEA expiration date.
+36 IF 'PSOCPRSU
IF ((PSCPRSSA="D")!(PSCPRSSA="B"))
IF PSOEDS="N"
IF ((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY)))
IF PSODNOBJ(.04)=""
QUIT 1
+37 ;
+38 ; CPRS Provider disusered and DEA is expiring within the next 30 days.
+39 IF PSOCPRSU
IF $LENGTH(PSOACC)
IF ((PSCPRSSA="D")!(PSCPRSSA="B"))
IF PSOEDS="3"
IF ((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY)))
IF PSODNOBJ(.04)'=""
IF (DEAEXPDT'>$$FMADD^XLFDT(DT,30))
IF DEAEXPDT>$$FMADD^XLFDT(DT,-1)
QUIT 1
+40 ; All (CPRS and Non-CPRS) disusered Provider and DEA is expiring within the next 30 days.
+41 IF 'PSOCPRSU
IF ((PSCPRSSA="D")!(PSCPRSSA="B"))
IF PSOEDS="3"
IF ((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY)))
IF PSODNOBJ(.04)'=""
IF (DEAEXPDT'>$$FMADD^XLFDT(DT,30))
IF DEAEXPDT>$$FMADD^XLFDT(DT,-1)
QUIT 1
+42 ;
+43 ; CPRS Provider disusered and DEA is expiring within the next 90 days.
+44 IF PSOCPRSU
IF $LENGTH(PSOACC)
IF ((PSCPRSSA="D")!(PSCPRSSA="B"))
IF PSOEDS="9"
IF ((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY)))
IF PSODNOBJ(.04)'=""
IF (DEAEXPDT'>$$FMADD^XLFDT(DT,90))
IF DEAEXPDT>$$FMADD^XLFDT(DT,-1)
QUIT 1
+45 ; All (CPRS and Non-CPRS) disusered and DEA is expiring within the next 90 days.
+46 IF 'PSOCPRSU
IF ((PSCPRSSA="D")!(PSCPRSSA="B"))
IF PSOEDS="9"
IF ((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY)))
IF PSODNOBJ(.04)'=""
IF (DEAEXPDT'>$$FMADD^XLFDT(DT,90))
IF DEAEXPDT>$$FMADD^XLFDT(DT,-1)
QUIT 1
+47 ;
+48 QUIT RESP
