- XUSNPIE2 ;FO-OAKLAND/JLI - DATA ENTRY FOR INITIAL NPI VALUES ; Dec 16, 2021@08:24:28
- ;;8.0;KERNEL;**410,435,454,462,480,519,752,764**;Jul 10, 1995;Build 1
- ;;Per VHA Directive 2004-038, this routine should not be modified
- Q
- ;
- PRINTOPT ;
- N DIR,%ZIS,ION,OPTION,PRNTFRMT,XUSDIV,XUSSORT,XUSRESO,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,XUSER
- K IO("Q")
- W !,"Select one of the following:",!!,?11,"1",?21,"All providers",!,?11,"2",?21,"All providers without NPI numbers",!
- S DIR(0)="N^1:2",DIR("A")="Select a report option",DIR("B")="1" D ^DIR K DIR Q:Y'>0 S OPTION=+Y
- S XUSRESO="" D Q:XUSRESO=""
- . S DIR(0)="S^P:Providers who are not residents;R:Residents only;B:Both"
- . S DIR("B")="P",DIR("A")="Selection: "
- . D ^DIR K DIR Q:"PRB"'[Y
- . S XUSRESO=Y Q
- ; Change of XU*8*519 #1 (add 3 lines of code below)
- W !!,"Select one of the following:",!!,?11,"1",?21,"ACTIVE users only",!,?11,"2",?21,"ACTIVE and DISUSERed users",!
- S DIR(0)="N^1:2",DIR("A")="Select a report option",DIR("B")="1" D ^DIR K DIR Q:Y'>0 S XUSER=+Y
- ; End XU*8*519 #1
- ;
- S DIR(0)="Y",DIR("B")="NO",DIR("A")="Sort by DIVISION" D ^DIR K DIR Q:Y="^" S XUSDIV=+Y
- S PRNTFRMT=1
- I XUSDIV S DIR(0)="N^1:2",DIR("A")="Output type (1=Printed text or 2=^-delimited)" D ^DIR K DIR Q:Y'>0 S PRNTFRMT=Y
- S DIR(0)="Y",DIR("B")="YES",DIR("A")="Sort by SERVICE/SECTION"_$S(XUSDIV>0:" (as well)",1:"") D ^DIR K DIR Q:Y="^" S XUSSORT=+Y
- W !!,">>> Report processing time is approximately 10 minutes."
- W !," Recommend text output be queued to a network printer."
- W !
- S %ZIS="MQ" D ^%ZIS Q:POP
- I $D(IO("Q")) D Q
- . S ZTSAVE("OPTION")="",ZTSAVE("XUSSORT")="",ZTSAVE("XUSDIV")="",ZTSAVE("PRNTFRMT")="",ZTSAVE("XUSRESO")="",ZTSAVE("XUSER")=""
- . S ZTIO=ION,ZTRTN="DQ^XUSNPIE2",ZTDESC="NPI PRINT JOB FOR OPTION "_OPTION
- . D ^%ZTLOAD W:$D(ZTSK) !,"Queued as Task "_ZTSK D HOME^%ZIS Q
- ;
- DQ ; entry point for queued print job
- U IO D PRNTPROV(OPTION,XUSSORT,XUSDIV,PRNTFRMT,XUSRESO,XUSER)
- U IO D ^%ZISC
- Q
- ;
- PRNTPROV(OPTION,XUSSORT,XUSDIV,PRNTFRMT,XUSRESO,XUSER) ;
- ; PRINT PROVIDER INFO
- ;
- ; OPTION SPECIFIES TYPE OF PRINT - 1=ALL PROVIDERS, 2=NEEDS NPI ONLY
- ; XUSSORT INDICATES WHETHER SORTED BY SERVICE/SECTION
- ; XUSDIV INDICATES WHETHER SORTED BY DIVISION
- ; PRNTFRMT INDICATES TYPE OF OUTPUT, PRINTED OR ^-DELIMITED
- ;
- ; ZEXCEPT: IOSL - KERNEL VARIABLE
- S XUSER=$G(XUSER) ;add p 519
- N PAGENUM,LINENUM,PROVNAME,TAXDESCR,TAXONOMY,SERVSECT,DIRUT,DTOUT
- N GLOBLOC,IEN,NPI,DATETIME,GLOBVALU,NCOUNT,GLOBLOC1,XUSDIVNM,CNTTOTAL,CNTNONE,CNTEXMPT,CNTDONE,MULTDIV,MULTDIVC,XUSDIS
- S CNTTOTAL=0,CNTNONE=0,CNTEXMPT=0,CNTDONE=0,XUSDIS=""
- S PAGENUM=0,LINENUM=0
- S DATETIME=$$NOW^XLFDT()
- S XUSNPIBA="XUSNPIPRNT"
- S GLOBLOC1=$$GETDATA(OPTION,XUSSORT,XUSDIV,XUSRESO,XUSER)
- I PRNTFRMT'=1 W !,"PROVIDER_NAME^LAST4^IEN^NPI^TAXONOMY_CODE^TAXONOMY DESCRIPTION"_$S(XUSDIV:"^DIVISION",1:"")_$S(XUSSORT:"^SERVICE/SECTION",1:"")
- S GLOBLOC=GLOBLOC1,XUSDIVNM="" F S XUSDIVNM=$O(@GLOBLOC1@(XUSDIVNM)) Q:XUSDIVNM="" D Q:$D(DIRUT)!$D(DTOUT)
- . S SERVSECT="" F S SERVSECT=$O(@GLOBLOC1@(XUSDIVNM,SERVSECT)) Q:SERVSECT="" S GLOBLOC=$NA(@GLOBLOC1@(XUSDIVNM,SERVSECT)) D Q:$D(DIRUT)!$D(DTOUT)
- . . I PRNTFRMT=1 D HEADER(OPTION,DATETIME,.PAGENUM,.LINENUM,XUSDIV,XUSDIVNM,XUSSORT,SERVSECT,XUSRESO,XUSER) Q:$D(DIRUT)!$D(DTOUT)
- . . S PROVNAME="" F S PROVNAME=$O(@GLOBLOC@(PROVNAME)) Q:PROVNAME="" Q:$D(DIRUT)!$D(DTOUT) S IEN=0 F S IEN=$O(@GLOBLOC@(PROVNAME,IEN)) Q:IEN'>0 D Q:$D(DIRUT)!$D(DTOUT)
- . . . S NCOUNT=0
- . . . S TAXDESCR="" F S TAXDESCR=$O(@GLOBLOC@(PROVNAME,IEN,TAXDESCR)) Q:TAXDESCR="" S GLOBVALU=@GLOBLOC@(PROVNAME,IEN,TAXDESCR) D
- . . . . S NPI=$P(GLOBVALU,U,3),TAXONOMY=$P(GLOBVALU,U,4),XUSDIS=$P(GLOBVALU,U,6)
- . . . . I PRNTFRMT=1 S NCOUNT=NCOUNT+1 W:NCOUNT=1 !,PROVNAME,?33,$$ALIGNRGT(IEN,11),?49,NPI,?65,XUSDIS W !,?6,TAXONOMY," ",TAXDESCR
- . . . . I PRNTFRMT'=1 W !,PROVNAME_U_$E($$GET1^DIQ(200,IEN_",",9),6,9)_U_IEN_U_NPI_U_TAXONOMY_U_TAXDESCR_$S(XUSDIV:U_XUSDIVNM,1:"")_$S(XUSSORT:U_SERVSECT,1:"")
- . . . . Q
- . . . I PRNTFRMT=1 S LINENUM=LINENUM+NCOUNT+1 I LINENUM>(IOSL-4) D HEADER(OPTION,DATETIME,.PAGENUM,.LINENUM,XUSDIV,XUSDIVNM,XUSSORT,SERVSECT,XUSRESO,XUSER) Q:$D(DIRUT)!$D(DTOUT)
- . . . Q
- . . Q
- . Q
- I '($D(DIRUT)!$D(DTOUT)),PRNTFRMT=1 D
- . S PROVNAME="" I $O(@GLOBLOC@(PROVNAME))="" W !,?20,"* * * N O D A T A F O U N D * * *",!! I 1
- . E D
- . . N TOTTYP S TOTTYP=$S(XUSRESO="R":"Residents",1:"Billable Providers")
- . . W !!,"Total "_TOTTYP_":",?43,CNTTOTAL,!,TOTTYP_" with an NPI:",?43,CNTDONE,!,"EXEMPT "_TOTTYP_":",?43,CNTEXMPT,!,TOTTYP_" Still Needing an NPI:",?43,CNTNONE
- . . I $G(MULTDIV)>0 W !!,MULTDIV," Providers were repeated a total of ",MULTDIVC," times",!," due to listing under multiple divisions"
- . . Q
- . W !!,?27,"*** End of Report ***"
- . Q
- Q
- ;
- ; ZEXCEPT: IOF,IOST KERNEL IO VARIABLES
- ; ZEXCEPT: DIRUT,DTOUT NEWED IN CALLING PRNTPROV - INDICATE QUIT TO PRNTPROV
- N TEMPVAL,DIR,X,Y
- S PAGNOREF=PAGNOREF+1
- S XUSER=$G(XUSER) ; add p 519
- ; Don't page feed on the first page
- IF PAGNOREF>1 I $E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR I 'Y S DIRUT=1 Q
- IF PAGNOREF>1 W @IOF
- W:$E(IOST,1,2)'="C-" !
- W "Active Provider Report ("_$S(XUSRESO="P":"no residents)",XUSRESO="R":"residents only)",1:"includes residents)")
- W ?48,$$FMTE^XLFDT(DATETIME)," Page: ",PAGNOREF
- W !,"Report Option: Provider List Active ",$S(XUSER=2:"and Disuser ",1:""),"Providers",$S(OPTION=2:" Without NPI Numbers",1:"")
- W !!,"Provider Name",?39,"IEN",?49,$S(OPTION'=2:"NPI",1:""),?65,$S(XUSER=2:"Disuser",1:"")
- W !," Taxonomy"
- W !,"--------------------------------------------------------------------------------"
- S LINNOREF=6
- I XUSDIV W !,"DIVISION: ",XUSDIVNM," " S LINNOREF=LINNOREF+1
- I XUSSORT W:'XUSDIV ! W "SERVICE/SECTION: ",SERVSECT S:'XUSDIV LINNOREF=LINNOREF+1
- Q
- ;
- GETDATA(OPTION,XUSSORT,XUSDIV,XUSRESO,XUSER) ; get data for reports for providers
- N NPI,PROVNAME,TAXDESCR,TAXONOMY,XUSDEFLT,XUSDIVCN,XUSDIVN,XUSDIVNM,XUSGLOB,XUSACTV,XUSSKIP
- N XUSIEN,XUSSERVC,XUSVAL,CNTCLEAN,X,XUSDIS
- S XUSRESO=$G(XUSRESO)
- S XUSER=$G(XUSER) I XUSER="" S XUSER=1 ;add p 519 - active users only reported
- S XUSDIS="" ; p 519
- ; ZEXCEPT: CNTTOTAL,CNTNONE,CNTEXMPT,CNTDONE - NEWed and initialized in PRNTPROV or killed based on CNTCLEAN
- S CNTCLEAN=0 I '$D(CNTTOTAL) S CNTCLEAN=1
- S XUSGLOB=$NA(^TMP($J,"XUSNPIPRNT")) K @XUSGLOB
- I 'XUSDIV S XUSDIVNM(1)=" ",XUSDEFLT=" "
- I XUSDIV S XUSDEFLT=$$NS^XUAF4($$KSP^XUPARAM("INST")),XUSDEFLT=$P(XUSDEFLT,U)
- I 'XUSSORT S XUSSERVC=" "
- N XUS1,XUS2
- F XUSIEN=0:0 S XUSIEN=$O(^VA(200,XUSIEN)) Q:(XUSIEN'>0)!(XUSIEN'=+XUSIEN) D
- . ; Don't report TERMINATED
- . S XUSACTV=$$ACTIVE^XUSER(XUSIEN)
- . I XUSACTV=""!($P(XUSACTV,U,2)="TERMINATED") Q ;p 519
- . I XUSER=1,$P(XUSACTV,U)=0 Q ;p 519
- . S XUSDIS="" I $P(XUSACTV,U,2)="DISUSER" S XUSDIS="Yes" ;p 519
- . ; Don't report users with null NPI ENTRY STATUS
- . S XUSVAL=$$CHEKNPI^XUSNPIED(XUSIEN),XUSVAL=$$NPISTATS^XUSNPIED(XUSIEN)
- . I $$GETNPI^XUSNPIED(XUSIEN)>0 S $P(^VA(200,XUSIEN,"NPI"),"^",2)="D",XUSVAL=$$NPISTATS^XUSNPIED(XUSIEN) ; p764
- . Q:XUSVAL=""
- . S PROVNAME=$$GET1^DIQ(200,XUSIEN_",",.01),NPI=$$GETNPI^XUSNPIED(XUSIEN),TAXONOMY=$$GETTAXON^XUSNPIED(XUSIEN,.TAXDESCR) I TAXONOMY=-1 S TAXONOMY=" ",TAXDESCR=" "
- . ; Determine whether provider is a resident for local reports.
- . I OPTION'=3,XUSRESO'="B" S XUSSKIP=0 D Q:XUSSKIP
- . . I XUSRESO="R",TAXONOMY'="390200000X" S XUSSKIP=1 Q
- . . I XUSRESO="P",TAXONOMY="390200000X" S XUSSKIP=1
- . . Q
- . I NPI="",$$EXMPTNPI^XUSNPIED(XUSIEN) S NPI="EXEMPTED "
- . I NPI="",XUSVAL="D" S XUSVAL="N",$P(^VA(200,XUSIEN,"NPI"),"^",2)=XUSVAL ;p752 to correct the NPI ENTRY STATUS
- . S CNTTOTAL=$G(CNTTOTAL)+1 S:NPI="" CNTNONE=$G(CNTNONE)+1 S:NPI="EXEMPTED " CNTEXMPT=$G(CNTEXMPT)+1 S:NPI?10N CNTDONE=$G(CNTDONE)+1
- . I '((XUSVAL="N")!(OPTION'=2)) Q
- . I XUSSORT S XUSSERVC=$$GET1^DIQ(200,XUSIEN_",",29) I XUSSERVC="" S XUSSERVC=" "
- . I XUSDIV D
- . . K XUSDIVNM S XUSDIVCN=0,XUSDIVNM(1)=XUSDEFLT
- . . F XUSDIVN=0:0 S XUSDIVN=$O(^VA(200,XUSIEN,2,XUSDIVN)) Q:XUSDIVN'>0 S XUSDIVCN=XUSDIVCN+1,XUSDIVNM(XUSDIVCN)=$$GET1^DIQ(200.02,XUSDIVN_","_XUSIEN_",",.01)
- . . I XUSDIVCN>1 S MULTDIV=$G(MULTDIV)+1,MULTDIVC=$G(MULTDIVC)+XUSDIVCN-1
- . . Q
- . F XUSDIVN=0:0 S XUSDIVN=$O(XUSDIVNM(XUSDIVN)) Q:XUSDIVN'>0 D
- . . S X=PROVNAME_U_XUSIEN_U_NPI_U_TAXONOMY_U_TAXDESCR I XUSDIS="Yes" S X=X_U_XUSDIS ;p 519 add piece #6 on X
- . . S @XUSGLOB@(XUSDIVNM(XUSDIVN),XUSSERVC,PROVNAME,XUSIEN,TAXDESCR)=X
- . . Q
- . Q
- I CNTCLEAN K CNTTOTAL,CNTNONE,CNTEXMPT,CNTDONE
- Q XUSGLOB
- ;
- ALIGNRGT(TEXT,WIDTH) ; align text right in a specified width
- N RESULT
- S $P(RESULT," ",WIDTH)=" ",RESULT=RESULT_TEXT,RESULT=$E(RESULT,$L(RESULT)-WIDTH+1,$L(RESULT))
- Q RESULT
- ;
- CHKOLD1(IEN) ; check for earlier value, and activate if present
- N IEN1,STATUS,NPI,DATE,XUFDA
- S IEN1=$O(^VA(200,IEN,"NPISTATUS"," "),-1) I IEN1>0 D I STATUS=0 D CHKOLD1(IEN)
- . S STATUS=^VA(200,IEN,"NPISTATUS",IEN1,0),NPI=$P(STATUS,U,3),DATE=$P(STATUS,U),STATUS=$P(STATUS,U,2)
- . I STATUS=0 D DELETNPI(IEN,IEN1,DATE) Q ; entry making it INACTIVE - remove it
- . I STATUS=1 D SET^XUSNPIE1(IEN,NPI)
- . Q
- Q
- ;
- DELETNPI(IEN,OIEN,ODATEVAL) ;
- N XUFDA
- I $D(ODATEVAL) S XUFDA(200.042,OIEN_","_IEN_",",.01)="@" D FILE^DIE("","XUFDA")
- I $O(^VA(200,IEN,"NPISTATUS",0))>0 Q
- N XUFDA
- I $$GET1^DIQ(200,IEN_",",41.99) S XUFDA(200,IEN_",",41.99)="@"
- I $$GET1^DIQ(200,IEN_",",41.98)'="" S XUFDA(200,IEN_",",41.98)="@"
- I $D(XUFDA) D FILE^DIE("","XUFDA")
- Q
- ;
- CLERXMPT ; edit entry indicating whether a provider is exempt from needing an NPI
- N DIC,DIR,FDA,IEN,Y
- W ! S DIC="^VA(200,",DIC(0)="AEQ" S DIC("A")="select Provider: " D ^DIC Q:Y'>0 S IEN=+Y
- I $$HASNPI^XUSNPIED(IEN) W !,"This Provider already has an NPI value. Nothing to do." Q
- I '$$CHEKNPI^XUSNPIED(IEN),'$$EXMPTNPI^XUSNPIED(IEN) W !,"This Provider does not appear to need an NPI or Exemption." Q
- I $$EXMPTNPI^XUSNPIED(IEN) D Q ; currently marked as Exempt
- . S DIR(0)="Y",DIR("A")="Provider is currently EXEMPT from needing an NPI, set to NEEDS an NPI (Y/N)" D ^DIR I 'Y Q
- . S FDA(200,IEN_",",41.98)="N" D FILE^DIE("","FDA")
- . W !,$S($$NEEDSNPI^XUSNPIED(IEN):"File updated",1:"Ecountered a problem updating file, status NOT set to NEEDS an NPI")
- . Q
- ; check to make sure provider should be exempt
- S DIR(0)="Y",DIR("A")="Confirm that Provider should be Exempt from needing an NPI (Y/N)" D ^DIR I 'Y Q
- ; and update file to show as exempt
- S FDA(200,IEN_",",41.98)="E" D FILE^DIE("","FDA")
- W !,$S($$EXMPTNPI^XUSNPIED(IEN):"File updated",1:"Ecountered a problem updating file, status NOT set to EXEMPT")
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSNPIE2 10822 printed Feb 18, 2025@23:39:07 Page 2
- XUSNPIE2 ;FO-OAKLAND/JLI - DATA ENTRY FOR INITIAL NPI VALUES ; Dec 16, 2021@08:24:28
- +1 ;;8.0;KERNEL;**410,435,454,462,480,519,752,764**;Jul 10, 1995;Build 1
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified
- +3 QUIT
- +4 ;
- PRINTOPT ;
- +1 NEW DIR,%ZIS,ION,OPTION,PRNTFRMT,XUSDIV,XUSSORT,XUSRESO,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,XUSER
- +2 KILL IO("Q")
- +3 WRITE !,"Select one of the following:",!!,?11,"1",?21,"All providers",!,?11,"2",?21,"All providers without NPI numbers",!
- +4 SET DIR(0)="N^1:2"
- SET DIR("A")="Select a report option"
- SET DIR("B")="1"
- DO ^DIR
- KILL DIR
- if Y'>0
- QUIT
- SET OPTION=+Y
- +5 SET XUSRESO=""
- Begin DoDot:1
- +6 SET DIR(0)="S^P:Providers who are not residents;R:Residents only;B:Both"
- +7 SET DIR("B")="P"
- SET DIR("A")="Selection: "
- +8 DO ^DIR
- KILL DIR
- if "PRB"'[Y
- QUIT
- +9 SET XUSRESO=Y
- QUIT
- End DoDot:1
- if XUSRESO=""
- QUIT
- +10 ; Change of XU*8*519 #1 (add 3 lines of code below)
- +11 WRITE !!,"Select one of the following:",!!,?11,"1",?21,"ACTIVE users only",!,?11,"2",?21,"ACTIVE and DISUSERed users",!
- +12 SET DIR(0)="N^1:2"
- SET DIR("A")="Select a report option"
- SET DIR("B")="1"
- DO ^DIR
- KILL DIR
- if Y'>0
- QUIT
- SET XUSER=+Y
- +13 ; End XU*8*519 #1
- +14 ;
- +15 SET DIR(0)="Y"
- SET DIR("B")="NO"
- SET DIR("A")="Sort by DIVISION"
- DO ^DIR
- KILL DIR
- if Y="^"
- QUIT
- SET XUSDIV=+Y
- +16 SET PRNTFRMT=1
- +17 IF XUSDIV
- SET DIR(0)="N^1:2"
- SET DIR("A")="Output type (1=Printed text or 2=^-delimited)"
- DO ^DIR
- KILL DIR
- if Y'>0
- QUIT
- SET PRNTFRMT=Y
- +18 SET DIR(0)="Y"
- SET DIR("B")="YES"
- SET DIR("A")="Sort by SERVICE/SECTION"_$SELECT(XUSDIV>0:" (as well)",1:"")
- DO ^DIR
- KILL DIR
- if Y="^"
- QUIT
- SET XUSSORT=+Y
- +19 WRITE !!,">>> Report processing time is approximately 10 minutes."
- +20 WRITE !," Recommend text output be queued to a network printer."
- +21 WRITE !
- +22 SET %ZIS="MQ"
- DO ^%ZIS
- if POP
- QUIT
- +23 IF $DATA(IO("Q"))
- Begin DoDot:1
- +24 SET ZTSAVE("OPTION")=""
- SET ZTSAVE("XUSSORT")=""
- SET ZTSAVE("XUSDIV")=""
- SET ZTSAVE("PRNTFRMT")=""
- SET ZTSAVE("XUSRESO")=""
- SET ZTSAVE("XUSER")=""
- +25 SET ZTIO=ION
- SET ZTRTN="DQ^XUSNPIE2"
- SET ZTDESC="NPI PRINT JOB FOR OPTION "_OPTION
- +26 DO ^%ZTLOAD
- if $DATA(ZTSK)
- WRITE !,"Queued as Task "_ZTSK
- DO HOME^%ZIS
- QUIT
- End DoDot:1
- QUIT
- +27 ;
- DQ ; entry point for queued print job
- +1 USE IO
- DO PRNTPROV(OPTION,XUSSORT,XUSDIV,PRNTFRMT,XUSRESO,XUSER)
- +2 USE IO
- DO ^%ZISC
- +3 QUIT
- +4 ;
- PRNTPROV(OPTION,XUSSORT,XUSDIV,PRNTFRMT,XUSRESO,XUSER) ;
- +1 ; PRINT PROVIDER INFO
- +2 ;
- +3 ; OPTION SPECIFIES TYPE OF PRINT - 1=ALL PROVIDERS, 2=NEEDS NPI ONLY
- +4 ; XUSSORT INDICATES WHETHER SORTED BY SERVICE/SECTION
- +5 ; XUSDIV INDICATES WHETHER SORTED BY DIVISION
- +6 ; PRNTFRMT INDICATES TYPE OF OUTPUT, PRINTED OR ^-DELIMITED
- +7 ;
- +8 ; ZEXCEPT: IOSL - KERNEL VARIABLE
- +9 ;add p 519
- SET XUSER=$GET(XUSER)
- +10 NEW PAGENUM,LINENUM,PROVNAME,TAXDESCR,TAXONOMY,SERVSECT,DIRUT,DTOUT
- +11 NEW GLOBLOC,IEN,NPI,DATETIME,GLOBVALU,NCOUNT,GLOBLOC1,XUSDIVNM,CNTTOTAL,CNTNONE,CNTEXMPT,CNTDONE,MULTDIV,MULTDIVC,XUSDIS
- +12 SET CNTTOTAL=0
- SET CNTNONE=0
- SET CNTEXMPT=0
- SET CNTDONE=0
- SET XUSDIS=""
- +13 SET PAGENUM=0
- SET LINENUM=0
- +14 SET DATETIME=$$NOW^XLFDT()
- +15 SET XUSNPIBA="XUSNPIPRNT"
- +16 SET GLOBLOC1=$$GETDATA(OPTION,XUSSORT,XUSDIV,XUSRESO,XUSER)
- +17 IF PRNTFRMT'=1
- WRITE !,"PROVIDER_NAME^LAST4^IEN^NPI^TAXONOMY_CODE^TAXONOMY DESCRIPTION"_$SELECT(XUSDIV:"^DIVISION",1:"")_$SELECT(XUSSORT:"^SERVICE/SECTION",1:"")
- +18 SET GLOBLOC=GLOBLOC1
- SET XUSDIVNM=""
- FOR
- SET XUSDIVNM=$ORDER(@GLOBLOC1@(XUSDIVNM))
- if XUSDIVNM=""
- QUIT
- Begin DoDot:1
- +19 SET SERVSECT=""
- FOR
- SET SERVSECT=$ORDER(@GLOBLOC1@(XUSDIVNM,SERVSECT))
- if SERVSECT=""
- QUIT
- SET GLOBLOC=$NAME(@GLOBLOC1@(XUSDIVNM,SERVSECT))
- Begin DoDot:2
- +20 IF PRNTFRMT=1
- DO HEADER(OPTION,DATETIME,.PAGENUM,.LINENUM,XUSDIV,XUSDIVNM,XUSSORT,SERVSECT,XUSRESO,XUSER)
- if $DATA(DIRUT)!$DATA(DTOUT)
- QUIT
- +21 SET PROVNAME=""
- FOR
- SET PROVNAME=$ORDER(@GLOBLOC@(PROVNAME))
- if PROVNAME=""
- QUIT
- if $DATA(DIRUT)!$DATA(DTOUT)
- QUIT
- SET IEN=0
- FOR
- SET IEN=$ORDER(@GLOBLOC@(PROVNAME,IEN))
- if IEN'>0
- QUIT
- Begin DoDot:3
- +22 SET NCOUNT=0
- +23 SET TAXDESCR=""
- FOR
- SET TAXDESCR=$ORDER(@GLOBLOC@(PROVNAME,IEN,TAXDESCR))
- if TAXDESCR=""
- QUIT
- SET GLOBVALU=@GLOBLOC@(PROVNAME,IEN,TAXDESCR)
- Begin DoDot:4
- +24 SET NPI=$PIECE(GLOBVALU,U,3)
- SET TAXONOMY=$PIECE(GLOBVALU,U,4)
- SET XUSDIS=$PIECE(GLOBVALU,U,6)
- +25 IF PRNTFRMT=1
- SET NCOUNT=NCOUNT+1
- if NCOUNT=1
- WRITE !,PROVNAME,?33,$$ALIGNRGT(IEN,11),?49,NPI,?65,XUSDIS
- WRITE !,?6,TAXONOMY," ",TAXDESCR
- +26 IF PRNTFRMT'=1
- WRITE !,PROVNAME_U_$EXTRACT($$GET1^DIQ(200,IEN_",",9),6,9)_U_IEN_U_NPI_U_TAXONOMY_U_TAXDESCR_$SELECT(XUSDIV:U_XUSDIVNM,1:"")_$SELECT(XUSSORT:U_SERVSECT,1:"")
- +27 QUIT
- End DoDot:4
- +28 IF PRNTFRMT=1
- SET LINENUM=LINENUM+NCOUNT+1
- IF LINENUM>(IOSL-4)
- DO HEADER(OPTION,DATETIME,.PAGENUM,.LINENUM,XUSDIV,XUSDIVNM,XUSSORT,SERVSECT,XUSRESO,XUSER)
- if $DATA(DIRUT)!$DATA(DTOUT)
- QUIT
- +29 QUIT
- End DoDot:3
- if $DATA(DIRUT)!$DATA(DTOUT)
- QUIT
- +30 QUIT
- End DoDot:2
- if $DATA(DIRUT)!$DATA(DTOUT)
- QUIT
- +31 QUIT
- End DoDot:1
- if $DATA(DIRUT)!$DATA(DTOUT)
- QUIT
- +32 IF '($DATA(DIRUT)!$DATA(DTOUT))
- IF PRNTFRMT=1
- Begin DoDot:1
- +33 SET PROVNAME=""
- IF $ORDER(@GLOBLOC@(PROVNAME))=""
- WRITE !,?20,"* * * N O D A T A F O U N D * * *",!!
- IF 1
- +34 IF '$TEST
- Begin DoDot:2
- +35 NEW TOTTYP
- SET TOTTYP=$SELECT(XUSRESO="R":"Residents",1:"Billable Providers")
- +36 WRITE !!,"Total "_TOTTYP_":",?43,CNTTOTAL,!,TOTTYP_" with an NPI:",?43,CNTDONE,!,"EXEMPT "_TOTTYP_":",?43,CNTEXMPT,!,TOTTYP_" Still Needing an NPI:",?43,CNTNONE
- +37 IF $GET(MULTDIV)>0
- WRITE !!,MULTDIV," Providers were repeated a total of ",MULTDIVC," times",!," due to listing under multiple divisions"
- +38 QUIT
- End DoDot:2
- +39 WRITE !!,?27,"*** End of Report ***"
- +40 QUIT
- End DoDot:1
- +41 QUIT
- +42 ;
- +1 ; ZEXCEPT: IOF,IOST KERNEL IO VARIABLES
- +2 ; ZEXCEPT: DIRUT,DTOUT NEWED IN CALLING PRNTPROV - INDICATE QUIT TO PRNTPROV
- +3 NEW TEMPVAL,DIR,X,Y
- +4 SET PAGNOREF=PAGNOREF+1
- +5 ; add p 519
- SET XUSER=$GET(XUSER)
- +6 ; Don't page feed on the first page
- +7 IF PAGNOREF>1
- IF $EXTRACT(IOST,1,2)="C-"
- SET DIR(0)="E"
- DO ^DIR
- IF 'Y
- SET DIRUT=1
- QUIT
- +8 IF PAGNOREF>1
- WRITE @IOF
- +9 if $EXTRACT(IOST,1,2)'="C-"
- WRITE !
- +10 WRITE "Active Provider Report ("_$SELECT(XUSRESO="P":"no residents)",XUSRESO="R":"residents only)",1:"includes residents)")
- +11 WRITE ?48,$$FMTE^XLFDT(DATETIME)," Page: ",PAGNOREF
- +12 WRITE !,"Report Option: Provider List Active ",$SELECT(XUSER=2:"and Disuser ",1:""),"Providers",$SELECT(OPTION=2:" Without NPI Numbers",1:"")
- +13 WRITE !!,"Provider Name",?39,"IEN",?49,$SELECT(OPTION'=2:"NPI",1:""),?65,$SELECT(XUSER=2:"Disuser",1:"")
- +14 WRITE !," Taxonomy"
- +15 WRITE !,"--------------------------------------------------------------------------------"
- +16 SET LINNOREF=6
- +17 IF XUSDIV
- WRITE !,"DIVISION: ",XUSDIVNM," "
- SET LINNOREF=LINNOREF+1
- +18 IF XUSSORT
- if 'XUSDIV
- WRITE !
- WRITE "SERVICE/SECTION: ",SERVSECT
- if 'XUSDIV
- SET LINNOREF=LINNOREF+1
- +19 QUIT
- +20 ;
- GETDATA(OPTION,XUSSORT,XUSDIV,XUSRESO,XUSER) ; get data for reports for providers
- +1 NEW NPI,PROVNAME,TAXDESCR,TAXONOMY,XUSDEFLT,XUSDIVCN,XUSDIVN,XUSDIVNM,XUSGLOB,XUSACTV,XUSSKIP
- +2 NEW XUSIEN,XUSSERVC,XUSVAL,CNTCLEAN,X,XUSDIS
- +3 SET XUSRESO=$GET(XUSRESO)
- +4 ;add p 519 - active users only reported
- SET XUSER=$GET(XUSER)
- IF XUSER=""
- SET XUSER=1
- +5 ; p 519
- SET XUSDIS=""
- +6 ; ZEXCEPT: CNTTOTAL,CNTNONE,CNTEXMPT,CNTDONE - NEWed and initialized in PRNTPROV or killed based on CNTCLEAN
- +7 SET CNTCLEAN=0
- IF '$DATA(CNTTOTAL)
- SET CNTCLEAN=1
- +8 SET XUSGLOB=$NAME(^TMP($JOB,"XUSNPIPRNT"))
- KILL @XUSGLOB
- +9 IF 'XUSDIV
- SET XUSDIVNM(1)=" "
- SET XUSDEFLT=" "
- +10 IF XUSDIV
- SET XUSDEFLT=$$NS^XUAF4($$KSP^XUPARAM("INST"))
- SET XUSDEFLT=$PIECE(XUSDEFLT,U)
- +11 IF 'XUSSORT
- SET XUSSERVC=" "
- +12 NEW XUS1,XUS2
- +13 FOR XUSIEN=0:0
- SET XUSIEN=$ORDER(^VA(200,XUSIEN))
- if (XUSIEN'>0)!(XUSIEN'=+XUSIEN)
- QUIT
- Begin DoDot:1
- +14 ; Don't report TERMINATED
- +15 SET XUSACTV=$$ACTIVE^XUSER(XUSIEN)
- +16 ;p 519
- IF XUSACTV=""!($PIECE(XUSACTV,U,2)="TERMINATED")
- QUIT
- +17 ;p 519
- IF XUSER=1
- IF $PIECE(XUSACTV,U)=0
- QUIT
- +18 ;p 519
- SET XUSDIS=""
- IF $PIECE(XUSACTV,U,2)="DISUSER"
- SET XUSDIS="Yes"
- +19 ; Don't report users with null NPI ENTRY STATUS
- +20 SET XUSVAL=$$CHEKNPI^XUSNPIED(XUSIEN)
- SET XUSVAL=$$NPISTATS^XUSNPIED(XUSIEN)
- +21 ; p764
- IF $$GETNPI^XUSNPIED(XUSIEN)>0
- SET $PIECE(^VA(200,XUSIEN,"NPI"),"^",2)="D"
- SET XUSVAL=$$NPISTATS^XUSNPIED(XUSIEN)
- +22 if XUSVAL=""
- QUIT
- +23 SET PROVNAME=$$GET1^DIQ(200,XUSIEN_",",.01)
- SET NPI=$$GETNPI^XUSNPIED(XUSIEN)
- SET TAXONOMY=$$GETTAXON^XUSNPIED(XUSIEN,.TAXDESCR)
- IF TAXONOMY=-1
- SET TAXONOMY=" "
- SET TAXDESCR=" "
- +24 ; Determine whether provider is a resident for local reports.
- +25 IF OPTION'=3
- IF XUSRESO'="B"
- SET XUSSKIP=0
- Begin DoDot:2
- +26 IF XUSRESO="R"
- IF TAXONOMY'="390200000X"
- SET XUSSKIP=1
- QUIT
- +27 IF XUSRESO="P"
- IF TAXONOMY="390200000X"
- SET XUSSKIP=1
- +28 QUIT
- End DoDot:2
- if XUSSKIP
- QUIT
- +29 IF NPI=""
- IF $$EXMPTNPI^XUSNPIED(XUSIEN)
- SET NPI="EXEMPTED "
- +30 ;p752 to correct the NPI ENTRY STATUS
- IF NPI=""
- IF XUSVAL="D"
- SET XUSVAL="N"
- SET $PIECE(^VA(200,XUSIEN,"NPI"),"^",2)=XUSVAL
- +31 SET CNTTOTAL=$GET(CNTTOTAL)+1
- if NPI=""
- SET CNTNONE=$GET(CNTNONE)+1
- if NPI="EXEMPTED "
- SET CNTEXMPT=$GET(CNTEXMPT)+1
- if NPI?10N
- SET CNTDONE=$GET(CNTDONE)+1
- +32 IF '((XUSVAL="N")!(OPTION'=2))
- QUIT
- +33 IF XUSSORT
- SET XUSSERVC=$$GET1^DIQ(200,XUSIEN_",",29)
- IF XUSSERVC=""
- SET XUSSERVC=" "
- +34 IF XUSDIV
- Begin DoDot:2
- +35 KILL XUSDIVNM
- SET XUSDIVCN=0
- SET XUSDIVNM(1)=XUSDEFLT
- +36 FOR XUSDIVN=0:0
- SET XUSDIVN=$ORDER(^VA(200,XUSIEN,2,XUSDIVN))
- if XUSDIVN'>0
- QUIT
- SET XUSDIVCN=XUSDIVCN+1
- SET XUSDIVNM(XUSDIVCN)=$$GET1^DIQ(200.02,XUSDIVN_","_XUSIEN_",",.01)
- +37 IF XUSDIVCN>1
- SET MULTDIV=$GET(MULTDIV)+1
- SET MULTDIVC=$GET(MULTDIVC)+XUSDIVCN-1
- +38 QUIT
- End DoDot:2
- +39 FOR XUSDIVN=0:0
- SET XUSDIVN=$ORDER(XUSDIVNM(XUSDIVN))
- if XUSDIVN'>0
- QUIT
- Begin DoDot:2
- +40 ;p 519 add piece #6 on X
- SET X=PROVNAME_U_XUSIEN_U_NPI_U_TAXONOMY_U_TAXDESCR
- IF XUSDIS="Yes"
- SET X=X_U_XUSDIS
- +41 SET @XUSGLOB@(XUSDIVNM(XUSDIVN),XUSSERVC,PROVNAME,XUSIEN,TAXDESCR)=X
- +42 QUIT
- End DoDot:2
- +43 QUIT
- End DoDot:1
- +44 IF CNTCLEAN
- KILL CNTTOTAL,CNTNONE,CNTEXMPT,CNTDONE
- +45 QUIT XUSGLOB
- +46 ;
- ALIGNRGT(TEXT,WIDTH) ; align text right in a specified width
- +1 NEW RESULT
- +2 SET $PIECE(RESULT," ",WIDTH)=" "
- SET RESULT=RESULT_TEXT
- SET RESULT=$EXTRACT(RESULT,$LENGTH(RESULT)-WIDTH+1,$LENGTH(RESULT))
- +3 QUIT RESULT
- +4 ;
- CHKOLD1(IEN) ; check for earlier value, and activate if present
- +1 NEW IEN1,STATUS,NPI,DATE,XUFDA
- +2 SET IEN1=$ORDER(^VA(200,IEN,"NPISTATUS"," "),-1)
- IF IEN1>0
- Begin DoDot:1
- +3 SET STATUS=^VA(200,IEN,"NPISTATUS",IEN1,0)
- SET NPI=$PIECE(STATUS,U,3)
- SET DATE=$PIECE(STATUS,U)
- SET STATUS=$PIECE(STATUS,U,2)
- +4 ; entry making it INACTIVE - remove it
- IF STATUS=0
- DO DELETNPI(IEN,IEN1,DATE)
- QUIT
- +5 IF STATUS=1
- DO SET^XUSNPIE1(IEN,NPI)
- +6 QUIT
- End DoDot:1
- IF STATUS=0
- DO CHKOLD1(IEN)
- +7 QUIT
- +8 ;
- DELETNPI(IEN,OIEN,ODATEVAL) ;
- +1 NEW XUFDA
- +2 IF $DATA(ODATEVAL)
- SET XUFDA(200.042,OIEN_","_IEN_",",.01)="@"
- DO FILE^DIE("","XUFDA")
- +3 IF $ORDER(^VA(200,IEN,"NPISTATUS",0))>0
- QUIT
- +4 NEW XUFDA
- +5 IF $$GET1^DIQ(200,IEN_",",41.99)
- SET XUFDA(200,IEN_",",41.99)="@"
- +6 IF $$GET1^DIQ(200,IEN_",",41.98)'=""
- SET XUFDA(200,IEN_",",41.98)="@"
- +7 IF $DATA(XUFDA)
- DO FILE^DIE("","XUFDA")
- +8 QUIT
- +9 ;
- CLERXMPT ; edit entry indicating whether a provider is exempt from needing an NPI
- +1 NEW DIC,DIR,FDA,IEN,Y
- +2 WRITE !
- SET DIC="^VA(200,"
- SET DIC(0)="AEQ"
- SET DIC("A")="select Provider: "
- DO ^DIC
- if Y'>0
- QUIT
- SET IEN=+Y
- +3 IF $$HASNPI^XUSNPIED(IEN)
- WRITE !,"This Provider already has an NPI value. Nothing to do."
- QUIT
- +4 IF '$$CHEKNPI^XUSNPIED(IEN)
- IF '$$EXMPTNPI^XUSNPIED(IEN)
- WRITE !,"This Provider does not appear to need an NPI or Exemption."
- QUIT
- +5 ; currently marked as Exempt
- IF $$EXMPTNPI^XUSNPIED(IEN)
- Begin DoDot:1
- +6 SET DIR(0)="Y"
- SET DIR("A")="Provider is currently EXEMPT from needing an NPI, set to NEEDS an NPI (Y/N)"
- DO ^DIR
- IF 'Y
- QUIT
- +7 SET FDA(200,IEN_",",41.98)="N"
- DO FILE^DIE("","FDA")
- +8 WRITE !,$SELECT($$NEEDSNPI^XUSNPIED(IEN):"File updated",1:"Ecountered a problem updating file, status NOT set to NEEDS an NPI")
- +9 QUIT
- End DoDot:1
- QUIT
- +10 ; check to make sure provider should be exempt
- +11 SET DIR(0)="Y"
- SET DIR("A")="Confirm that Provider should be Exempt from needing an NPI (Y/N)"
- DO ^DIR
- IF 'Y
- QUIT
- +12 ; and update file to show as exempt
- +13 SET FDA(200,IEN_",",41.98)="E"
- DO FILE^DIE("","FDA")
- +14 WRITE !,$SELECT($$EXMPTNPI^XUSNPIED(IEN):"File updated",1:"Ecountered a problem updating file, status NOT set to EXEMPT")
- +15 QUIT