Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSODEARP

PSODEARP.m

Go to the documentation of this file. 
  1. PSODEARP ;ALB/BI - DEA EXPIRATION DATE REPORT ;10/12/22  16:32
  1.  ;;7.0;OUTPATIENT PHARMACY;**667,684,545**;DEC 1997;Build 270
  1.  ;External reference to DEA NUMBERS file (#8991.9) is supported by DBIA 7002
  1.  ;External reference to sub-file NEW DEA #'S (#200.5321) is supported by DBIA 7000
  1.  Q
  1.  ;
  1. EN  ; Main Routine Entry Point
  1.  N DIROUT,DTOUT,DUOUT,PSOQ,PSOPAGE,POP,PSHEADER,PSCPRSSA,PSOEDS,PSOSCR,PSOOUT,PSOTYP,PSOCPRSU
  1.  S PSOPAGE=0
  1.  W !!,"Report requires 512 Columns"
  1.  S PSOQ=0          ; quit flag
  1.  S PSOCPRSU=""
  1.  ;
  1.  S PSHEADER="Includes: "
  1.  ;
  1.  ; Input Questions
  1.  ;
  1.  ; CPRS System Access {Active, DISUSERed, or Both}
  1.  S DIR(0)="S^A:Active;D:DISUSERed/Terminated;B:Both",DIR("A")="CPRS System Access" D ^DIR K DIR Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
  1.  S PSCPRSSA=Y
  1.  S PSOCPRSU=$$CPRSUSRS(PSCPRSSA) Q:PSOCPRSU<0
  1.  S PSHEADER=PSHEADER_$S(PSOCPRSU:"CPRS ",PSOCPRSU=0:"ALL Eligible ",1:"")
  1.  S PSHEADER=PSHEADER_$S(PSCPRSSA="A":"Active ",PSCPRSSA="D":"DISUSERed/Terminated ",PSCPRSSA="B":"Active, DISUSERed/Terminated, ",1:"")_"and "
  1.  ;
  1.  ; Expiration Date Status {EXPIRED, NO EXP DATE, <30-DAYS, <90-DAYS}
  1.  S DIR(0)="S^E:EXPIRED;N:NO EXP DATE;3:<30-DAYS;9:<90-DAYS",DIR("A")="Expiration Date Status" D ^DIR K DIR Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT)
  1.  S PSOEDS=Y,PSHEADER=PSHEADER_$S(Y="E":"Expired DEA Number.",Y="N":"No DEA Expiration Date.",Y="3":"DEA Expiring within next 30 days.",Y="9":"DEA Expiring within next 90 days.",1:"")
  1.  D  Q:$G(PSOTYP)="D"  I $G(PSOOUT) Q
  1.  . S PSOTYP=$$TYPE() I $G(PSOOUT) Q
  1.  . I $G(PSOTYP)="D" D DL^PSODEARV I $G(PSOOUT) Q
  1.  . I $G(PSOTYP)="D" D RUN^PSODEARV(PSHEADER,PSCPRSSA,PSOEDS,PSOCPRSU)
  1.  ;
  1.  D DEVICE Q:PSOQ   ; Print to device
  1.  D RUN(PSHEADER,PSCPRSSA,PSOEDS,PSOCPRSU) Q:PSOQ  ; Run Report
  1.  Q
  1.  ;
  1. GUI ; Entry point for ePCS GUI Report
  1.  N %H,PSOQ,PSOPAGE,PSOSCR,PSCPRSSA,PSOEDS,PSOCPRSU
  1.  ; I $G(ECPTYP)="E" D EXPORT,^EPCSKILL Q  ; ePCS not exporting to Excel at this point
  1.  S %H=$H D YX^%DTC S EPCSRDT=Y            ; Date report is run
  1.  S PSOQ=0          ; quit flag
  1.  S PSOPAGE=0
  1.  S PSOSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
  1.  S PSOCPRSU=$S(EPCSTYPE="C":1,EPCSTYPE="A":0)
  1.  S PSHEADER="Includes: "
  1.  S PSHEADER=PSHEADER_$S(PSOCPRSU:"CPRS ",PSOCPRSU=0:"ALL Eligible ",1:"")
  1.  ;
  1.  ; CPRS System Access {Active, DISUSERed/Terminated, or Both}
  1.  S PSHEADER=PSHEADER_$S(EPCSCPRS="A":"Active",EPCSCPRS="D":"DISUSERed/Terminated",EPCSCPRS="B":"Active, DISUSERed/Terminated,",1:"")_" and "
  1.  ;
  1.  ; Expiration Date Status {EXPIRED, NO EXP DATE, <30-DAYS, <90-DAYS}
  1.  S PSHEADER=PSHEADER_$S(EPCSSTAT="E":"Expired DEA Number.",EPCSSTAT="N":"No DEA Expiration Date.",EPCSSTAT="3":"DEA Expiring within next 30 days.",EPCSSTAT="9":"DEA Expiring within next 90 days.",1:"")
  1.  ;
  1.  S PSCPRSSA=EPCSCPRS S PSOEDS=EPCSSTAT
  1.  D RUN(PSHEADER,PSCPRSSA,PSOEDS,PSOCPRSU) Q:PSOQ      ; Run Report
  1.  ;I $D(EPCSGUI) D ^EPCSKILL Q    // Kill variables...
  1.  Q
  1.  ;
  1. DEVICE  ; Request Device Information
  1.  N %ZIS,IOP,ZTSK,ZTRTN,ZTIO,ZTDESC,ZTSAVE,POP,RTN,VAR
  1.  K IO("Q")
  1.  S %ZIS="QM"
  1.  W ! D ^%ZIS
  1.  I POP S PSOQ=1 Q
  1.  S PSOSCR=$S($E($G(IOST),1,2)="C-":1,1:0)
  1.  I $D(IO("Q")) D  S PSOQ=1
  1.  . S RTN=$P($T(+1)," ",1)
  1.  . S ZTRTN="RUN^"_RTN_"(PSHEADER,PSCPRSSA,PSOEDS)"
  1.  . S ZTIO=ION
  1.  . S ZTSAVE("PS*")=""
  1.  . S ZTDESC="DEA EXPIRATION REPORT"
  1.  . D ^%ZTLOAD
  1.  . W !,$S($D(ZTSK):"REQUEST QUEUED TASK="_ZTSK,1:"REQUEST CANCELLED")
  1.  . D HOME^%ZIS
  1.  U IO
  1.  Q
  1.  ;
  1. COMPILE(PSCPRSSA,PSOEDS,PSOCPRSU,PSOPROB)  ; -- Compile the report lines into the sort global
  1.  N DEAIEN,DEATXT,PSCOUNT1,PSOLINE,PSOTD
  1.  S PSCOUNT1=0
  1.  S DEATXT="" F  S DEATXT=$O(^XTV(8991.9,"B",DEATXT)) Q:DEATXT=""  D
  1.  . S DEAIEN=$O(^XTV(8991.9,"B",DEATXT,0)) Q:'DEAIEN
  1.  . S NPIEN="" F  S NPIEN=$O(^VA(200,"PS4",DEATXT,NPIEN)) Q:'NPIEN  D
  1.  . . K TMP,PSODNOBJ D GETS^DIQ(8991.9,DEAIEN_",","**","","TMP","MSG") M PSODNOBJ=TMP(8991.9,DEAIEN_",")
  1.  . . K TMP,PSONPOBJ D GETS^DIQ(200,NPIEN_",","**","","TMP","MSG") M PSONPOBJ=TMP(200,NPIEN_",")
  1.  . . S (PSOTD,PSONPOBJ(9.2))=$$GET1^DIQ(200,NPIEN_",",9.2,"I"),PSONPOBJ(9.2)=$$FMTE^XLFDT(PSONPOBJ(9.2),"5DZ")
  1.  . . S PSONPOBJ(202)=$$GET1^DIQ(200,NPIEN_",",202,"I"),PSONPOBJ(202)=$$FMTE^XLFDT(PSONPOBJ(202),"5DZ")
  1.  . . S PSODNOBJ(.04)=$$GET1^DIQ(8991.9,DEAIEN_",",.04,"I"),PSODNOBJ(.04)=$$FMTE^XLFDT(PSODNOBJ(.04),"5DZ")
  1.  . . S PSONPOBJ(747.44)=$$GET1^DIQ(200,NPIEN_",",747.44,"I"),PSONPOBJ(747.44)=$$FMTE^XLFDT(PSONPOBJ(747.44),"5DZ")
  1.  . . Q:'$$TEST(.PSODNOBJ,.PSONPOBJ,PSCPRSSA,PSOEDS,NPIEN,PSOCPRSU)
  1.  . . N P200P5321 S P200P5321=$$FIND1^DIC(200.5321,","_NPIEN_",",,DEATXT)
  1.  . . I '$G(P200P5321) S PSODNOBJ(.01)="*PROBLEM*",PSOPROB=$G(PSOPROB)+1
  1.  . . S PSOLINE=""
  1.  . . S PSOLINE=PSOLINE_$$LJ^XLFSTR(PSONPOBJ(9.2),"12T")_"  "               ; TERMINATION DATE       #200,    #9.2
  1.  . . S PSOLINE=PSOLINE_$$LJ^XLFSTR(PSONPOBJ(.01),"33T")_"  "               ; NAME                   #200,    #.01
  1.  . . S PSOLINE=PSOLINE_$$LJ^XLFSTR(PSODNOBJ(.01),"9T")_"  "               ; DEA                    #8991.9, #.01
  1.  . . S PSOLINE=PSOLINE_$$LJ^XLFSTR(PSODNOBJ(.04),"12T")_"  "              ; DEA Expiration Date    #8991.9, #.04
  1.  . . ;S PSOLINE=PSOLINE_$$LJ^XLFSTR(PSONPOBJ(53.2),"9T")_"  "               ; DEA                    #200,    #53.2
  1.  . . ;S PSOLINE=PSOLINE_$$LJ^XLFSTR(PSONPOBJ(747.44),"12T")_"  "            ; DEA Expiration Date    #200,    #747.44
  1.  . . S PSOLINE=PSOLINE_$$LJ^XLFSTR(PSONPOBJ(202),"12T")_"  "               ; LAST SIGN-ON           #200,    #202
  1.  . . S PSOLINE=PSOLINE_$$LJ^XLFSTR(PSONPOBJ(8),"23T")_"  "                 ; TITLE                  #200,    #8
  1.  . . S PSOLINE=PSOLINE_$$LJ^XLFSTR(PSONPOBJ(29),"16T")_"  "                ; SERVICE/SECTION        #200,    #29
  1.  . . S PSCOUNT1=PSCOUNT1+1
  1.  . . S PSOTD=$S(PSOTD:PSOTD,1:1)
  1.  . . S ^TMP($J,"PSODEARP",PSOTD,PSONPOBJ(.01),PSCOUNT1,1)=PSOLINE
  1.  . . ;
  1.  . . D:PSONPOBJ(53.9)'=""
  1.  . . . S PSOLINE=$$LJ^XLFSTR("                         ","21T")             ; INDENT 21 SPACES
  1.  . . . S PSOLINE=PSOLINE_"REMARKS: "_$$LJ^XLFSTR(PSONPOBJ(53.9),"100T")     ; REMARKS FIELD          #200,    #53.9
  1.  . . . S ^TMP($J,"PSODEARP",PSOTD,PSONPOBJ(.01),PSCOUNT1,2)=PSOLINE
  1.  . . ;
  1.  . . S PSOLINE=""                                                          ; BLANK LINE
  1.  . . S ^TMP($J,"PSODEARP",PSOTD,PSONPOBJ(.01),PSCOUNT1,3)=PSOLINE
  1.  Q
  1.  ;
  1. RUN(PSHEADER,PSCPRSSA,PSOEDS,PSOCPRSU)  ; Run Report
  1.  N PSCOUNT2,PSOTD,PSONAME,PSOPROB
  1.  S PSOPROB=0  ; Track orphan x-refs in ^VA(200,"PS1"
  1.  K ^TMP($J,"PSODEARP") ; Clear the temporary accumulator
  1.  D COMPILE(PSCPRSSA,PSOEDS,PSOCPRSU,.PSOPROB)
  1.  U IO
  1.  D HDR(PSHEADER)
  1.  I '$D(^TMP($J,"PSODEARP")) W "There is no Data to Print",!
  1.  S PSOTD=0 F  S PSOTD=$O(^TMP($J,"PSODEARP",PSOTD)) Q:+PSOTD=0  Q:PSOQ  D
  1.  . S PSONAME="" F  S PSONAME=$O(^TMP($J,"PSODEARP",PSOTD,PSONAME)) Q:PSONAME=""  Q:PSOQ  D
  1.  .. S PSCOUNT2=0 F  S PSCOUNT2=$O(^TMP($J,"PSODEARP",PSOTD,PSONAME,PSCOUNT2)) Q:+PSCOUNT2=0  Q:PSOQ  D
  1.  ... W ^TMP($J,"PSODEARP",PSOTD,PSONAME,PSCOUNT2,1),! D CHKP(PSHEADER) Q:PSOQ
  1.  ... I $D(^TMP($J,"PSODEARP",PSOTD,PSONAME,PSCOUNT2,2)) D  Q:PSOQ
  1.  .... W ^TMP($J,"PSODEARP",PSOTD,PSONAME,PSCOUNT2,2),! D CHKP(PSHEADER) Q:PSOQ
  1.  ... W ^TMP($J,"PSODEARP",PSOTD,PSONAME,PSCOUNT2,3),! D CHKP(PSHEADER) Q:PSOQ
  1.  I 'PSOQ,$G(PSOPROB) D
  1.  . W !,"*PROBLEM* INDICATES BAD CROSS REFERENCE IN NEW PERSON FILE.",!,"CONTACT PRODUCT SUPPORT TO RESOLVE.",!
  1.  I $D(EPCSGUI) Q
  1.  I 'PSOSCR W !,@IOF
  1.  D ^%ZISC
  1.  K ^TMP($J,"PSODEARP") ; Clear the temporary accumulator
  1.  Q:PSOQ
  1.  I PSOSCR K DIR("A") S DIR(0)="E" D ^DIR K DIR
  1.  Q
  1.  ;
  1. HDR(PSHEADER)  ; Report header
  1.  N PSOI
  1.  S PSOPAGE=PSOPAGE+1
  1.  W @IOF,?(IOM-83),"DEA Expiration Date Report"
  1.  W !,PSHEADER,?(IOM-45),"     Run Date: ",$$FMTE^XLFDT(DT,"5DZ"),?(IOM-12)," Page: ",PSOPAGE,!
  1.  W !,$$TITLES
  1.  W ! F PSOI=1:1:$S($G(IOM):(IOM-1),1:130) W "-"
  1.  W !
  1.  Q
  1.  ;
  1. CHKP(PSHEADER)  ; Check for End Of Page
  1.  I $Y>(IOSL-4) D:PSOSCR  Q:PSOQ  D HDR(PSHEADER)
  1.  . N X,Y,DTOUT,DUOUT,DIRUT,DIR
  1.  . U IO(0) S DIR(0)="E" D ^DIR K DIR S:$D(DIRUT) PSOQ=2
  1.  . U IO
  1.  Q
  1.  ;
  1. TITLES()  ; -- Create the header TITLES.
  1.  N TITLES
  1.  S TITLES=""
  1.  S TITLES=TITLES_$$LJ^XLFSTR("TERM DATE","12T")_"  "        ; TERMINATION DATE       #200,    #9.2
  1.  S TITLES=TITLES_$$LJ^XLFSTR("NAME","33T")_"  "             ; NAME                   #8991.9, #1.1
  1.  S TITLES=TITLES_$$LJ^XLFSTR("DEA","9T")_"  "               ; DEA                    #8991.9, #.01
  1.  S TITLES=TITLES_$$LJ^XLFSTR("DEA EXP DT","12T")_"  "       ; DEA Expiration Date    #8991.9, #.04
  1.  S TITLES=TITLES_$$LJ^XLFSTR("LAST SIGN-ON","12T")_"  "     ; LAST SIGN-ON           #200,    #202
  1.  S TITLES=TITLES_$$LJ^XLFSTR("TITLE","23T")_"  "            ; TITLE                  #200,    #8
  1.  S TITLES=TITLES_$$LJ^XLFSTR("SERVICE/SECTION","16T")_"  "  ; SERVICE/SECTION        #200,    #29
  1.  Q TITLES
  1.  ;
  1. TEST(PSODNOBJ,PSONPOBJ,PSCPRSSA,PSOEDS,NPIEN,PSOCPRSU)  ; -- Perform the requested test for screening critera
  1.  N DEAEXPDT D DT^DILF("",PSODNOBJ(.04),.DEAEXPDT)
  1.  N RESP,PSOACC S RESP=0
  1.  N PSOTERM,PSOTODAY
  1.  S PSOTERM=$$GET1^DIQ(200,NPIEN,9.2,"I")
  1.  S PSOTODAY=$$DT^XLFDT
  1.  S PSOACC=$$GET1^DIQ(200,NPIEN,2,"I")
  1.  ;
  1.  ; CPRS Provider Active and DEA is expired.
  1.  I PSOCPRSU,((PSCPRSSA="A")!(PSCPRSSA="B")),PSOEDS="E",$$ACTIVE^XUSER(NPIEN),PSODNOBJ(.04)'="",(DEAEXPDT<$$DT^XLFDT()) Q 1  ; Active CPRS Providers Only
  1.  ; All (CPRS and Non-CPRS) Active Providers and DEA is expired
  1.  I 'PSOCPRSU,((PSCPRSSA="A")!(PSCPRSSA="B")),PSOEDS="E",PSONPOBJ(7)'="YES",('PSOTERM!(PSOTERM>PSOTODAY)),PSODNOBJ(.04)'="",(DEAEXPDT<$$DT^XLFDT()) Q 1     ; All Active Providers
  1.  ;
  1.  ; CPRS Provider Active and does not have a DEA expiration date.
  1.  I PSOCPRSU,((PSCPRSSA="A")!(PSCPRSSA="B")),PSOEDS="N",$$ACTIVE^XUSER(NPIEN),PSODNOBJ(.04)="" Q 1   ; Active CPRS Providers Only
  1.  ; All (CPRS and Non-CPRS) Active Provider and does not have a DEA expiration date.
  1.  I 'PSOCPRSU,((PSCPRSSA="A")!(PSCPRSSA="B")),PSOEDS="N",PSONPOBJ(7)'="YES",('PSOTERM!(PSOTERM>PSOTODAY)),PSODNOBJ(.04)="" Q 1      ; All Active Providers
  1.  ;
  1.  ; CPRS Provider Active and DEA is expiring within next 30 days.
  1.  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
  1.  ; All (CPRS and Non-CPRS) Active Provider and DEA is expiring within next 30 days.
  1.  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
  1.  ;
  1.  ; CPRS Provider Active and DEA expiring within the next 90 days.
  1.  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
  1.  ; All (CPRS and Non-CPRS) Active DEA expiring within the next 90 days.
  1.  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
  1.  ;
  1.  ; CPRS Provider disusered and DEA is expired.
  1.  I PSOCPRSU,$L(PSOACC),((PSCPRSSA="D")!(PSCPRSSA="B")),PSOEDS="E",((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY))),PSODNOBJ(.04)'="",(DEAEXPDT<$$DT^XLFDT()) Q 1
  1.  ; All (CPRS and Non-CPRS) disusered provider and DEA is expired.
  1.  I 'PSOCPRSU,((PSCPRSSA="D")!(PSCPRSSA="B")),PSOEDS="E",((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY))),PSODNOBJ(.04)'="",(DEAEXPDT<$$DT^XLFDT()) Q 1
  1.  ;
  1.  ; CPRS Provider disusered and does not have a DEA expiration date.
  1.  I PSOCPRSU,$L(PSOACC),((PSCPRSSA="D")!(PSCPRSSA="B")),PSOEDS="N",((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY))),PSODNOBJ(.04)="" Q 1
  1.  ; All (CPRS and Non-CPRS) disusered provider and does not have a DEA expiration date.
  1.  I 'PSOCPRSU,((PSCPRSSA="D")!(PSCPRSSA="B")),PSOEDS="N",((PSONPOBJ(7)="YES")!(PSOTERM&(PSOTERM<PSOTODAY))),PSODNOBJ(.04)="" Q 1
  1.  ;
  1.  ; CPRS Provider disusered and DEA is expiring within the next 30 days.
  1.  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
  1.  ; All (CPRS and Non-CPRS) disusered Provider and DEA is expiring within the next 30 days.
  1.  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
  1.  ;
  1.  ; CPRS Provider disusered and DEA is expiring within the next 90 days.
  1.  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
  1.  ; All (CPRS and Non-CPRS) disusered and DEA is expiring within the next 90 days.
  1.  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
  1.  ;
  1.  Q RESP
  1.  ;
  1. TYPE() ;Prompt for report format or delimited list
  1.  N PSOTYP
  1.  S PSOTYP=""
  1.  W ! K DIR,Y S DIR(0)="S^R:Report;D:Delimited File"
  1.  S DIR("?",1)="Enter 'R' to see the output in a report format,"
  1.  S DIR("?")="enter 'D' for a delimited list that can be exported to Excel."
  1.  S DIR("A")="Select (R)eport or (D)elimited File"
  1.  S DIR("B")="R"
  1.  D ^DIR K DIR I $D(DIRUT) S PSOOUT=1 K DIRUT,DTOUT,DUOUT,DIR,X,Y Q PSOTYP
  1.  S PSOTYP=Y
  1.  K DIRUT,DTOUT,DUOUT,DIR,X,Y
  1.  Q PSOTYP
  1.  ;
  1. CPRSUSRS(STATUS) ; Ask user if they want to constrain report to users with ACCESS CODE (CPRS Users) or ALL (e.g., Comm Care/Non-VA)
  1.  ; Active CPRS System Access only, or ALL active access (i.e., no ACCESS CODE for Community Care/Non-VA providers) 
  1.  N DIR,STATUSE
  1.  S STATUSE=$S($G(STATUS)="A":"Active ",$G(STATUS)="D":"Disusered/Terminated ",1:"")
  1.  S DIR(0)="S^CPRS:CPRS "_STATUSE_"Providers Only;ALL:ALL Eligible "_STATUSE_"Providers",DIR("A")="Type of System Access"
  1.  S DIR("?",1)="If CPRS is selected, only providers with an ACCESS CODE are displayed."
  1.  S DIR("?")="If ALL is selected, providers with and without an ACCESS CODE are displayed."
  1.  D ^DIR K DIR Q:$D(DUOUT)!$D(DTOUT)!$D(DIROUT) -1
  1.  Q $S(Y="CPRS":1,Y="ALL":0,1:-1)